'From Cuis 1.0 of 26 March 2009 [latest update: #158] on 1 April 2009 at 5:54:17 pm'!

!Object methodsFor: 'copying' stamp: 'sw 5/4/1998 11:28'!
copyAddedStateFrom: anotherObject
	"Copy the values of instance variables added by the receiver's class from anotherObject to the receiver"

	self class superclass instSize + 1 to: self class instSize do:
		[:index | self instVarAt: index put: (anotherObject instVarAt: index)]! !

!Object methodsFor: 'testing' stamp: 'md 4/30/2003 15:30'!
isSymbol
	^ false ! !

!Object methodsFor: 'updating'!
update: aParameter 
	"Receive a change notice from an object of whom the receiver is a 
	dependent. The default behavior is to do nothing; a subclass might want 
	to change itself in some way."

	^self! !


!ADPCMCodec methodsFor: 'private' stamp: 'jm 3/28/1999 16:08'!
indexForDeltaFrom: thisSample to: nextSample
	"Answer the best index to use for the difference between the given samples."
	"Details: Scan stepSizeTable for the first entry >= the absolute value of the difference between sample values. Since indexes are zero-based, the index used during decoding will be the one in the following stepSizeTable entry. Since the index field of a Flash frame header is only six bits, the maximum index value is 63."
	"Note: Since there does not appear to be any documentation of how Flash acutally computes the indices used in its frame headers, this algorithm was guessed by reverse-engineering the Flash ADPCM decoder."

	| diff bestIndex |
	self inline: true.

	diff _ nextSample - thisSample.
	diff < 0 ifTrue: [diff _ 0 - diff].
	bestIndex _ 63.
	1 to: 62 do: [:j |
		bestIndex = 63 ifTrue: [
			(stepSizeTable at: j) >= diff ifTrue: [bestIndex _ j]]].
	^ bestIndex
! !


!AssignmentNode methodsFor: 'printing'!
printOn: aStream indent: level

	variable printOn: aStream indent: level.
	aStream nextPutAll: ' _ '.
	value printOn: aStream indent: level + 2! !


!Behavior methodsFor: 'instance creation' stamp: 'tk 4/16/1999 20:24'!
basicNew: anInteger 
	"Primitive. Answer an instance of the receiver (which is a class) with the 
	number of indexable variables specified by the argument, anInteger. Fail 
	if the class is not indexable or if the argument is not a positive Integer. 
	Essential. See Object documentation whatIsAPrimitive."

	<primitive: 71>
	self isVariable ifFalse: [
		self error: self printString, ' cannot have variable sized instances'].
	(anInteger isInteger and: [anInteger >= 0]) ifTrue: [
		"arg okay; space must be low"
		Smalltalk signalLowSpace.
		^ self basicNew: anInteger  "retry if user proceeds"
	].
	self primitiveFailed! !

!Behavior methodsFor: 'testing method dictionary'!
allUnsentMessages
	"Answer an array of all the messages defined by the receiver that are not sent anywhere in the system.  5/8/96 sw"

	^ Smalltalk allUnSentMessagesIn: self selectors! !

!Behavior methodsFor: 'Camp Smalltalk' stamp: 'Sames 2/19/2001 13:14'!
sunitAllSelectors

        ^self allSelectors asSortedCollection asOrderedCollection! !


!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:50'!
and: block1 and: block2
	"Nonevaluating conjunction without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as false, then return false immediately,
		without evaluating any further blocks.
	If all return true, then return true."

	self ifFalse: [^ false].
	block1 value ifFalse: [^ false].
	block2 value ifFalse: [^ false].
	^ true! !

!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:49'!
and: block1 and: block2 and: block3
	"Nonevaluating conjunction without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as false, then return false immediately,
		without evaluating any further blocks.
	If all return true, then return true."

	self ifFalse: [^ false].
	block1 value ifFalse: [^ false].
	block2 value ifFalse: [^ false].
	block3 value ifFalse: [^ false].
	^ true! !

!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:49'!
and: block1 and: block2 and: block3 and: block4
	"Nonevaluating conjunction without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as false, then return false immediately,
		without evaluating any further blocks.
	If all return true, then return true."

	self ifFalse: [^ false].
	block1 value ifFalse: [^ false].
	block2 value ifFalse: [^ false].
	block3 value ifFalse: [^ false].
	block4 value ifFalse: [^ false].
	^ true! !

!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:52'!
or: block1 or: block2
	"Nonevaluating alternation without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as true, then return true immediately,
		without evaluating any further blocks.
	If all return false, then return false."

	self ifTrue: [^ true].
	block1 value ifTrue: [^ true].
	block2 value ifTrue: [^ true].
	^ false! !

!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:52'!
or: block1 or: block2 or: block3
	"Nonevaluating alternation without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as true, then return true immediately,
		without evaluating any further blocks.
	If all return false, then return false."

	self ifTrue: [^ true].
	block1 value ifTrue: [^ true].
	block2 value ifTrue: [^ true].
	block3 value ifTrue: [^ true].
	^ false! !

!Boolean methodsFor: 'controlling' stamp: 'di 12/5/2001 10:52'!
or: block1 or: block2 or: block3 or: block4
	"Nonevaluating alternation without deep nesting.
	The reciever is evaluated, followed by the blocks in order.
	If any of these evaluates as true, then return true immediately,
		without evaluating any further blocks.
	If all return false, then return false."

	self ifTrue: [^ true].
	block1 value ifTrue: [^ true].
	block2 value ifTrue: [^ true].
	block3 value ifTrue: [^ true].
	block4 value ifTrue: [^ true].
	^ false! !


!ChangeSet methodsFor: 'method changes' stamp: 'di 4/1/2000 12:00'!
selectorsInClass: aClass
	"Used by a ChangeSorter to access the list methods."

	^ (changeRecords at: aClass ifAbsent: [^#()]) changedSelectors! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'RAA 5/28/2001 11:46'!
checkForUnsentMessages
	"Check the change set for unsent messages, and if any are found, open up a message-list browser on them"

	| nameLine allChangedSelectors augList unsent |

	nameLine _ '"', self name, '"'.
	allChangedSelectors _ Set new.
	(augList _ self changedMessageListAugmented) do: [ :each |
		each isValid ifTrue: [allChangedSelectors add: each methodSymbol]
	].

	unsent _ Smalltalk allUnSentMessagesIn: allChangedSelectors.
	unsent size = 0 ifTrue: [
		^self inform: 'There are no unsent 
messages in change set
', nameLine
	].

	Smalltalk 
		browseMessageList: (augList select: [ :each | unsent includes: each methodSymbol]) 
		name: 'Unsent messages in ', nameLine! !

!ChangeSet methodsFor: 'fileIn/Out' stamp: 'di 9/24/1999 12:33'!
summaryString
	"Answer the string summarizing this changeSet"

	^ self summaryStringDelta: 0
"
To summarize all recent changeSets on a file...
(FileStream newFileNamed: 'Summaries.txt') nextPutAll:
	(String streamContents:
		[:s | (ChangeSorter changeSetsNamedSuchThat:
			[:name | name first isDigit and: [name initialIntegerOrNil >= 948]])
			 do: [:cs | s nextPutAll: cs summaryString; cr]]);
		close

To list all changeSets with a certain string in the preamble...
	(FileStream newFileNamed: 'MyUpdates.txt') nextPutAll:
		(String streamContents:
			[:s | ChangeSorter gatherChangeSets do:
				[:cs | (cs preambleString notNil
					and: [cs preambleString includesSubString: 'Author Name'])
				 	ifTrue: [s nextPutAll: cs summaryString; cr]]]);
		close
"! !


!ClassDescription methodsFor: 'method dictionary' stamp: 'sw 12/12/2000 12:26'!
allMethodsInCategory: aName
	"Answer a list of all the method categories of the receiver and all its superclasses"

	| aColl |
	aColl _ OrderedCollection new.
	self withAllSuperclasses do:
		[:aClass | aColl addAll:
			(aName = ClassOrganizer allCategory
				ifTrue:
					[aClass organization allMethodSelectors]
				ifFalse:
					[aClass organization listAtCategoryNamed: aName])].
	^ aColl asSet asSortedArray

"TileMorph allMethodsInCategory: #initialization"! !


!BorderStyle class methodsFor: 'instance creation' stamp: 'sw 11/27/2001 15:22'!
simple
	"Answer a simple border style"

	^ SimpleBorder new! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'ar 8/25/2001 16:19'!
width: aNumber color: aColor
	^SimpleBorder new color: aColor; width: aNumber; yourself! !


!Collection methodsFor: 'accessing' stamp: 'ar 4/16/1999 07:56'!
capacity
	"Return the current capacity of the receiver"
	^self size! !

!Collection methodsFor: 'accessing'!
size
	"Answer how many elements the receiver contains."

	| tally |
	tally _ 0.
	self do: [:each | tally _ tally + 1].
	^tally! !

!Collection methodsFor: 'adding'!
addAll: aCollection 
	"Include all the elements of aCollection as the receiver's elements. Answer 
	aCollection."

	aCollection do: [:each | self add: each].
	^aCollection! !

!Collection methodsFor: 'comparing' stamp: 'di 12/14/1999 07:45'!
hash
	"A default hash function for any collection.  Note that this method is insensitive to contents when the size is greater than 10, so critical applications that compare many large collections of the same length will want to refine this behavior."

	| hash |
	hash _ self species hash.
	self size <= 10 ifTrue:
		[self do: [:elem | hash _ hash bitXor: elem hash]].
	^ hash bitXor: self size hash
! !

!Collection methodsFor: 'converting' stamp: 'ls 1/3/1999 13:48'!
asCharacterSet
	"Answer a CharacterSet whose elements are the unique elements of the receiver.  The reciever should only contain characters"

	^CharacterSet newFrom: self
! !

!Collection methodsFor: 'enumerating' stamp: 'di 11/21/1999 20:14'!
anySatisfy: aBlock
	"Evaluate aBlock with the elements of the receiver.
	If aBlock returns true for any element return true.
	Otherwise return false"

	self do:[:item | (aBlock value: item) ifTrue: [^ true]].
	^ false! !

!Collection methodsFor: 'enumerating'!
collect: aBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Collect the resulting values into a collection like the receiver. Answer 
	the new collection."

	| newCollection |
	newCollection _ self species new.
	self do: [:each | newCollection add: (aBlock value: each)].
	^newCollection! !

!Collection methodsFor: 'enumerating'!
collect: collectBlock thenSelect: selectBlock
	^ (self collect: collectBlock) select: selectBlock! !

!Collection methodsFor: 'enumerating'!
count: aBlock
	"Evaluate aBlock with each of the receiver's elements as the argument.  Return the number that answered true."

	| sum |
	sum _ 0.
	self do: [:each | 
		(aBlock value: each) ifTrue: [sum _ sum + 1]].
	^ sum! !

!Collection methodsFor: 'enumerating'!
detect: aBlock ifNone: exceptionBlock 
	"Evaluate aBlock with each of the receiver's elements as the argument. 
	Answer the first element for which aBlock evaluates to true. If none 
	evaluate to true, then evaluate the argument, exceptionBlock."

	self do: [:each | (aBlock value: each) ifTrue: [^each]].
	^exceptionBlock value! !

!Collection methodsFor: 'enumerating' stamp: 'di 8/11/1999 12:02'!
do: elementBlock separatedBy: separatorBlock
	| beforeFirst | 
	"Evaluate the elementBlock for all elements in the receiver,
	and evaluate the separatorBlock between."

	beforeFirst _ true.
	self do:
		[:element |
		beforeFirst ifTrue: [beforeFirst _ false]
				ifFalse: [separatorBlock value].
		elementBlock value: element].
! !

!Collection methodsFor: 'enumerating' stamp: 'ar 5/1/1999 05:00'!
do: aBlock without: anItem
	"Enumerate all elements in the receiver.
	Execute aBlock for those elements that are not equal to the given item"
	^self do:[:el| anItem = el ifFalse:[aBlock value: el]].! !

!Collection methodsFor: 'enumerating'!
select: selectBlock thenCollect: collectBlock
	^ (self select: selectBlock) collect: collectBlock! !


!Bag methodsFor: 'accessing'!
at: index

	self errorNotKeyed! !

!Bag methodsFor: 'accessing'!
at: index put: anObject

	self errorNotKeyed! !

!Bag methodsFor: 'accessing'!
size

	| tally |
	tally _ 0.
	contents do: [:each | tally _ tally + each].
	^tally! !

!Bag methodsFor: 'accessing'!
sortedCounts
	"Answer with a collection of counts with elements, sorted by decreasing
	count."

	| counts |
	counts _ SortedCollection sortBlock: [:x :y | x >= y].
	contents associationsDo:
		[:assn |
		counts add: (Association key: assn value value: assn key)].
	^counts! !

!Bag methodsFor: 'adding'!
add: newObject 
	"Refer to the comment in Collection|add:."

	^self add: newObject withOccurrences: 1! !

!Bag methodsFor: 'adding' stamp: 'TAG 10/13/1998 22:39'!
add: newObject withOccurrences: anInteger 
	"Add the element newObject to the receiver. Do so as though the element  
	were added anInteger number of times. Answer newObject."
	contents at: newObject put: (contents at: newObject ifAbsent: [0])
			+ anInteger.
	^ newObject! !

!Bag methodsFor: 'enumerating' stamp: 'SqR 11/4/97 19:58'!
asSet
	"Answer a set with the elements of the receiver"

	 ^contents keys! !


!Collection class methodsFor: 'instance creation' stamp: 'ar 9/10/1999 13:20'!
withAll: aCollection
	"Create a new collection containing all the elements from aCollection"
	^(self new: aCollection size)
		addAll: aCollection;
		yourself! !


!Color methodsFor: 'transformations' stamp: 'ar 5/22/2000 22:33'!
alpha: alphaValue
	"Return a new TransparentColor with the given amount of opacity ('alpha')."
	alphaValue = 1.0 ifFalse:[
		^ TranslucentColor basicNew setRgb: rgb alpha: alphaValue
	].! !


!Compiler methodsFor: 'public access'!
format: textOrStream in: aClass notifying: aRequestor
	"Compile a parse tree from the argument, textOrStream. Answer a string 
	containing the original code, formatted nicely."

	| aNode |
	self from: textOrStream
		class: aClass
		context: nil
		notifying: aRequestor.
	aNode _ self format: sourceStream noPattern: false ifFail: [^nil].
	^aNode decompileString! !


!CompositionScanner methodsFor: 'scanning' stamp: 'hmm 2/9/2001 11:55'!
composeFrom: startIndex inRectangle: lineRectangle
	firstLine: firstLine leftSide: leftSide rightSide: rightSide
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."
	| runLength done stopCondition |
	"Set up margins"
	leftMargin _ lineRectangle left.
	leftSide ifTrue: [leftMargin _ leftMargin +
						(firstLine ifTrue: [textStyle firstIndent]
								ifFalse: [textStyle restIndent])].
	destX _ spaceX _ leftMargin.
	rightMargin _ lineRectangle right.
	rightSide ifTrue: [rightMargin _ rightMargin - textStyle rightIndent].
	lastIndex _ startIndex.	"scanning sets last index"
	destY _ lineRectangle top.
	lineHeight _ baseline _ 0.  "Will be increased by setFont"
	self setStopConditions.	"also sets font"
	runLength _ text runLengthFor: startIndex.
	runStopIndex _ (lastIndex _ startIndex) + (runLength - 1).
	line _ (TextLine start: lastIndex stop: 0 internalSpaces: 0 paddingWidth: 0)
				rectangle: lineRectangle.
	spaceCount _ 0.
	self handleIndentation.
	leftMargin _ destX.
	line leftMargin: leftMargin.

	done _ false.
	[done]
		whileFalse: 
			[stopCondition _ self scanCharactersFrom: lastIndex to: runStopIndex
				in: text string rightX: rightMargin stopConditions: stopConditions
				kern: kern.
			"See setStopConditions for stopping conditions for composing."
			(self perform: stopCondition)
				ifTrue: [^ line lineHeight: lineHeight + textStyle leading
							baseline: baseline + textStyle leading]]! !

!CompositionScanner methodsFor: 'stop conditions' stamp: 'ar 5/18/2000 16:48'!
setFont
	super setFont.
	stopConditions == DefaultStopConditions 
		ifTrue:[stopConditions _ stopConditions copy].
	stopConditions at: Space asciiValue + 1 put: #space.! !


!Date methodsFor: 'printing' stamp: 'tk 1/27/98 08:30'!
mmddyyyy
	"Answer the receiver rendered in standard fmt mm/dd/yyyy.  Good for avoiding year 2000 bugs.  Note that the name here is slightly misleading -- the month and day numbers don't show leading zeros, so that for example feb 1 1996 is 2/1/96"

	"Date today mmddyyyy"

	^ self printFormat: #(2 1 3 $/ 1 1)! !

!Date methodsFor: 'printing'!
printFormat: formatArray 
	"Answer a String describing the receiver using the format denoted by the 
	argument, formatArray."

	| aStream |
	aStream _ WriteStream on: (String new: 16).
	self printOn: aStream format: formatArray.
	^aStream contents! !

!Date methodsFor: 'converting' stamp: 'BP 5/18/2000 18:21'!
asDate

	^self! !


!Date class methodsFor: 'general inquiries'!
dateAndTimeNow
	"Answer an Array whose first element is Date today and second element 
	is Time now."

	^Time dateAndTimeNow! !


!Decompiler methodsFor: 'instruction decoding' stamp: 'tao 8/20/97 22:49'!
case: dist
	"statements = keyStmts CascadeFlag keyValueBlock ... keyStmts"

	| nextCase end thenJump stmtStream elements b node cases otherBlock |
	nextCase _ pc + dist.
	end _ limit.
	"Now add CascadeFlag & keyValueBlock to statements"
	statements addLast: stack removeLast.
	stack addLast: CaseFlag. "set for next pop"
	statements addLast: (self blockForCaseTo: nextCase).
	stack last == CaseFlag
		ifTrue: "Last case"
			["ensure jump is within block (in case thenExpr returns wierdly I guess)"
			stack removeLast. "get rid of CaseFlag".
			thenJump _ exit <= end ifTrue: [exit] ifFalse: [nextCase].
			stmtStream _ ReadStream on: (self popTo: stack removeLast).
			elements _ OrderedCollection new.
			b _ OrderedCollection new.
			[stmtStream atEnd] whileFalse:
				[(node _ stmtStream next) == CascadeFlag
					ifTrue:
						[elements addLast: (constructor
							codeMessage: (constructor codeBlock: b returns: false)
							selector: (constructor codeSelector: #-> code: #macro)
							arguments: (Array with: stmtStream next)).
						 b _ OrderedCollection new]
					ifFalse: [b addLast: node]].
			b size > 0 ifTrue: [self error: 'Bad cases'].
			cases _ constructor codeBrace: elements.
			otherBlock _ self blockTo: thenJump.
			stack addLast:
				(constructor
					codeMessage: stack removeLast
					selector: (constructor codeSelector: #caseOf:otherwise: code: #macro)
					arguments: (Array with: cases with: otherBlock))]! !


!DecompilerConstructor methodsFor: 'constructor'!
codeEmptyBlock

	^BlockNode withJust: NodeNil! !


!DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 3/7/2001 13:38'!
checkDeep
	"Write exceptions in the Transcript.  Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  This check is only run by hand once in a while to make sure nothing was forgotten.  
(Please do not remove this method.)
	DeepCopier new checkDeep 	"

| mm |
Transcript cr; show: 'Instance variables shared with the original object when it is copied'.
(Smalltalk allClassesImplementing: #veryDeepInner:) do: [:aClass | 
	(mm _ aClass instVarNames size) > 0 ifTrue: [
		(aClass instSize - mm + 1) to: aClass instSize do: [:index |
			((aClass compiledMethodAt: #veryDeepInner:) writesField: index) ifFalse: [
				Transcript cr; show: aClass name; space; 
					show: (aClass allInstVarNames at: index)]]]].
! !

!DeepCopier methodsFor: 'like fullCopy' stamp: 'tk 10/4/2001 13:45'!
checkVariables
	"Check that no indexes of instance vars have changed in certain classes.  If you get an error in this method, an implementation of veryDeepCopyWith: needs to be updated.  The idea is to catch a change while it is still in the system of the programmer who made it.  
	DeepCopier new checkVariables	"

	| meth |
	self checkBasicClasses.

	"Every class that implements veryDeepInner: must copy all its inst vars.  Danger is that a user will add a new instance variable and forget to copy it.  So check that the last one is mentioned in the copy method."
	(Smalltalk allClassesImplementing: #veryDeepInner:) do: [:aClass | 
		((aClass compiledMethodAt: #veryDeepInner:) writesField: aClass instSize) ifFalse: [
			aClass instSize > 0 ifTrue: [
				self warnIverNotCopiedIn: aClass sel: #veryDeepInner:]]].
	(Smalltalk allClassesImplementing: #veryDeepCopyWith:) do: [:aClass | 
		meth _ aClass compiledMethodAt: #veryDeepCopyWith:.
		(meth size > 20) & (meth literals includes: #veryDeepCopyWith:) not ifTrue: [
			(meth writesField: aClass instSize) ifFalse: [
				self warnIverNotCopiedIn: aClass sel: #veryDeepCopyWith:]]].

! !


!Delay methodsFor: 'private' stamp: 'jm 9/11/97 14:49'!
adjustResumptionTimeOldBase: oldBaseTime newBase: newBaseTime
	"Private!! Adjust the value of the system's millisecond clock at which this Delay will be awoken. Used to adjust resumption times after a snapshot or clock roll-over."

	resumptionTime _ newBaseTime + (resumptionTime - oldBaseTime).
! !

!Delay methodsFor: 'private' stamp: 'jm 9/12/97 08:56'!
setDelay: millisecondCount forSemaphore: aSemaphore
	"Private!! Initialize this delay to signal the given semaphore after the given number of milliseconds."

	delayDuration _ millisecondCount.
	delaySemaphore _ aSemaphore.
	beingWaitedOn _ false.
! !

!Delay methodsFor: 'private' stamp: 'jm 9/11/97 11:54'!
signalWaitingProcess
	"The delay time has elapsed; signal the waiting process."

	beingWaitedOn _ false.
	delaySemaphore signal.
! !


!Delay class methodsFor: 'snapshotting' stamp: 'jm 9/11/97 15:15'!
saveResumptionTimes
	"Private!! Record the resumption times of all Delays relative to a base time of zero. This is done prior to snapshotting or adjusting the resumption times after a clock roll-over. This method should be called only while the AccessProtect semaphore is held."

	| oldBaseTime |
	oldBaseTime _ Time millisecondClockValue.
	ActiveDelay == nil
		ifFalse: [
			oldBaseTime < ActiveDelayStartTime
				ifTrue: [oldBaseTime _ ActiveDelayStartTime].  "clock rolled over"
			ActiveDelay adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
	SuspendedDelays do:
		[:d | d adjustResumptionTimeOldBase: oldBaseTime newBase: 0].
! !


!DisplayText methodsFor: 'private'!
composeForm

	form _ self asParagraph asForm! !


!Exception class methodsFor: 'exceptionSelector' stamp: 'tfei 6/4/1999 18:08'!
handles: exception
	"Determine whether an exception handler will accept a signaled exception."

	^exception isKindOf: self! !


!FWT methodsFor: 'access' stamp: 'di 10/31/1998 12:19'!
coeffs
	"Return all coefficients neede to reconstruct the original samples"
	| header csize strm |
	header _ Array with: nSamples with: nLevels with: alpha with: beta.
	csize _ header size.
	1 to: nLevels do: [:i | csize _ csize + (transform at: i*2) size].
	csize _ csize + (transform at: nLevels*2-1) size.
	coeffs _ Array new: csize.
	strm _ WriteStream on: coeffs.
	strm nextPutAll: header.
	1 to: nLevels do: [:i | strm nextPutAll: (transform at: i*2)].
	strm nextPutAll: (transform at: nLevels*2-1).
	^ coeffs! !


!FontSet class methodsFor: 'compiling'!
acceptsLoggingOfCompilation
	"Dont log sources for my subclasses, so as not to waste time and space
	storing printstring versions of the string literals."
	^ self == FontSet! !


!Form methodsFor: 'image manipulation' stamp: 'di 6/30/1998 08:24'!
tallyPixelValues
	"Return a Bitmap with tallies in it of the number of pixels in this Form that have each pixel value. Note that several Forms may be tallied into the same table by tallyPixelValuesPrimitive:into: with the same table. Also Forms of depth 16 or 32 can be tallied into a tables of size 512, 4096, or 32768 entries by making a direct call with a Bitmap of the given size."

	^ self tallyPixelValuesInRect: self boundingBox
		into: (Bitmap new: (1 bitShift: (self depth min: 15)))
"
Move a little rectangle around the screen and print its tallies...
 | r tallies nonZero |
Cursor blank showWhile: [
[Sensor anyButtonPressed] whileFalse:
	[r _ Sensor cursorPoint extent: 10@10.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil.
	tallies _ (Display copy: r) tallyPixelValues.
	nonZero _ (1 to: tallies size) select: [:i | (tallies at: i) > 0]
			thenCollect: [:i | (tallies at: i) -> (i-1)].
	nonZero printString , '          ' displayAt: 0@0.
	Display border: (r expandBy: 2) width: 2 rule: Form reverse fillColor: nil]]
"! !


!GrafPort methodsFor: 'drawing support' stamp: 'di 1/3/1999 13:08'!
image: aForm at: aPoint sourceRect: sourceRect rule: rule
	"Draw the portion of the given Form defined by sourceRect at the given point using the given BitBlt combination rule."

	sourceForm _ aForm.
	combinationRule_ rule.
	self sourceRect: sourceRect.
	self destOrigin: aPoint.
	self copyBits! !


!ImageSegment methodsFor: 'fileIn/Out' stamp: 'ar 8/16/2001 13:26'!
prepareToBeSaved
	"Prepare objects in outPointers to be written on the disk.  They must be able to match up with existing objects in their new system.  outPointers is already a copy.
	Classes are already converted to a DiskProxy.  
	Associations in outPointers:
1) in Smalltalk.
2) in a classPool.
3) in a shared pool.
4) A pool dict pointed at directly"

| left pool myClasses outIndexes key |
myClasses _ Set new.
arrayOfRoots do: [:aRoot | aRoot class class == Metaclass ifTrue: [myClasses add: aRoot]].
outIndexes _ IdentityDictionary new.
outPointers withIndexDo: [:anOut :ind | 
	anOut isVariableBinding ifTrue: [
		(myClasses includes: anOut value)
			ifFalse: [outIndexes at: anOut put: ind]
			ifTrue: [(Smalltalk associationAt: anOut key ifAbsent: [3]) == anOut 
				ifTrue: [outPointers at: ind put: 
					(DiskProxy global: #Smalltalk selector: #associationDeclareAt: 
						args: (Array with: anOut key))]
				ifFalse: [outIndexes at: anOut put: ind]
				]].
	(anOut isKindOf: Dictionary) ifTrue: ["Pools pointed at directly"
		(key _ Smalltalk keyAtIdentityValue: anOut ifAbsent: [nil]) ifNotNil: [
			outPointers at: ind put: 
				(DiskProxy global: key selector: #yourself args: #())]].
	anOut isMorph ifTrue: [outPointers at: ind put: 
		(StringMorph contents: anOut printString, ' that was not counted')]
	].
left _ outIndexes keys asSet.
left size > 0 ifTrue: ["Globals"
	(left copy) do: [:assoc |	"stay stable while delete items"
		(Smalltalk associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
			outPointers at: (outIndexes at: assoc) put: 
				(DiskProxy global: #Smalltalk selector: #associationAt: 
					args: (Array with: assoc key)).
			left remove: assoc]]].
left size > 0 ifTrue: ["Class variables"
	Smalltalk allClassesDo: [:cls | cls classPool size > 0 ifTrue: [
		(left copy) do: [:assoc |	"stay stable while delete items"
			(cls classPool associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
				outPointers at: (outIndexes at: assoc) put: 
					(DiskProxy new global: cls name
						preSelector: #classPool
						selector: #associationAt: 
						args: (Array with: assoc key)).
				left remove: assoc]]]]].
left size > 0 ifTrue: ["Pool variables"
	Smalltalk associationsDo: [:poolAssoc |
		poolAssoc value class == Dictionary ifTrue: ["a pool"
			pool _ poolAssoc value.
			(left copy) do: [:assoc |	"stay stable while delete items"
				(pool associationAt: assoc key ifAbsent: [3]) == assoc ifTrue: [
					outPointers at: (outIndexes at: assoc) put: 
						(DiskProxy global: poolAssoc key selector: #associationAt: 
							args: (Array with: assoc key)).
					left remove: assoc]]]]].
left size > 0 ifTrue: [
	"If points to class in arrayOfRoots, must deal with it separately"
	"OK to have obsolete associations that just get moved to the new system"
	self inform: 'extra associations'.
	left inspect].
! !


!Integer methodsFor: 'bit manipulation'!
>> shiftAmount  "left shift"
	shiftAmount < 0 ifTrue: [self error: 'negative arg'].
	^ self bitShift: 0 - shiftAmount! !


!LookupKey methodsFor: 'bindings' stamp: 'ar 8/16/2001 11:54'!
recompileBindingsAnnouncing: aBool
	"Make the receiver (a global read-write binding) be a read-only binding"
	aBool ifTrue:[
		Utilities informUserDuring:[:bar|
			(Smalltalk allCallsOn: self) do:[:mref| 
				bar value: 'Recompiling ', mref asStringOrText.
				mref actualClass recompile: mref methodSymbol].
		].
	] ifFalse:[
		(Smalltalk allCallsOn: self) do:[:mref| 
			mref actualClass recompile: mref methodSymbol].
	].! !


!LoopedSampledSound methodsFor: 'accessing' stamp: 'jm 3/15/1999 08:01'!
samples
	"For compatability with SampledSound. Just return my left channel (which is the only channel if I am mono)."

	^ leftSamples
! !


!MacHFSPlusFileDirectory class methodsFor: 'platform specific' stamp: 'JMM 12/5/2001 22:23'!
isActiveDirectoryClass
	"Ok, lets see if we support HFS Plus file names, the long ones"

	^ (self pathNameDelimiter = self primPathNameDelimiter) and: [(Smalltalk getSystemAttribute: 1201) notNil and: [(Smalltalk getSystemAttribute: 1201) asNumber > 31]]! !


!MessageNode methodsFor: 'macro transformations'!
transformIfTrueIfFalse: encoder
	^ (self checkBlock: (arguments at: 1) as: 'True arg' from: encoder)
		and: [self checkBlock: (arguments at: 2) as: 'False arg' from: encoder]! !


!MethodFinder methodsFor: 'initialize' stamp: 'tk 12/29/2000 13:38'!
copy: mthFinder addArg: aConstant
	| more |
	"Copy inputs and answers, add an additional data argument to the inputs.  The same constant for every example".

	more _ Array with: aConstant.
	data _ mthFinder data collect: [:argList | argList, more].
	answers _ mthFinder answers.
	self load: nil.
! !

!MethodFinder methodsFor: 'find a constant' stamp: 'jla 2/4/2001 18:30'!
constEquiv
	| const subTest got jj |
	"See if (data1 = C) or (data1 ~= C) is the answer"

	"quick test"
	((answers at: 1) class superclass == Boolean) ifFalse: [^ false].
	2 to: answers size do: [:ii | 
		((answers at: ii) class superclass == Boolean) ifFalse: [^ false]]..

	const _ (thisData at: 1) at: 1.
	got _ (subTest _ MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not.
	got ifFalse: ["try other polarity for ~~ "
		(jj _ answers indexOf: (answers at: 1) not) > 0 ifTrue: [
		const _ (thisData at: jj) at: 1.
		got _ (subTest _ MethodFinder new copy: self addArg: const) 
				searchForOne isEmpty not]]. 
	got ifFalse: [^ false]. 

	"replace data2 with const in expressions"
	subTest expressions do: [:exp |
		expressions add: (exp copyReplaceAll: 'data2' with: const printString)].
	selector addAll: subTest selectors.
	^ true! !


!Model methodsFor: 'menus' stamp: 'di 4/17/1998 08:29'!
step
	"Default for moephic models is no-op"! !


!CPUWatcher methodsFor: 'porcine capture' stamp: 'nk 3/8/2001 17:23'!
openMorphicWindowForSuspendedProcess: aProcess
	| menu rules |
	menu _ MenuMorph new.
	"nickname  allow-stop  allow-debug"
	rules _ ProcessBrowser nameAndRulesFor: aProcess.
	menu add: 'Dismiss this menu' target: menu selector: #delete; addLine.
	menu add: 'Open Process Browser' target: ProcessBrowser selector: #open.
	menu add: 'Resume'
		target: self
		selector: #resumeProcess:fromMenu:
		argumentList: { aProcess . menu }.
	menu add: 'Terminate'
		target: self
		selector: #terminateProcess:fromMenu:
		argumentList: { aProcess . menu }.
	rules third ifTrue: [
		menu add: 'Debug at a lower priority'
			target: self
			selector: #debugProcess:fromMenu:
			argumentList: { aProcess . menu }.
	].
	menu addTitle: aProcess identityHash asString,
		' ', rules first,
		' is taking too much time and has been suspended.
What do you want to do with it?'.
	menu stayUp: true.
	menu popUpInWorld
! !


!DualChangeSorter methodsFor: 'initialization' stamp: 'sd 5/23/2003 14:38'!
morphicWindow
	
	| window |
	leftCngSorter _ ChangeSorter new myChangeSet: ChangeSet current.
	leftCngSorter parent: self.
	rightCngSorter _ ChangeSorter new myChangeSet: 
			ChangeSorter secondaryChangeSet.
	rightCngSorter parent: self.

	window _ (SystemWindow labelled: leftCngSorter label) model: self.
	"topView minimumSize: 300 @ 200."
	leftCngSorter openAsMorphIn: window rect: (0@0 extent: 0.5@1).
	rightCngSorter openAsMorphIn: window rect: (0.5@0 extent: 0.5@1).
	^ window
! !


!Month methodsFor: 'inquiries' stamp: 'LC 7/26/1998 12:50'!
name
	^ self monthName! !

!Month methodsFor: 'printing' stamp: 'LC 7/26/1998 02:24'!
printOn: aStream
	aStream nextPutAll: self monthName, ' ', self year printString! !


!Morph methodsFor: 'accessing' stamp: 'nk 4/15/2004 10:55'!
borderColor: aColorOrSymbolOrNil 
	"Unfortunately, the argument to borderColor could be more than 	just a color. 
	It could also be a symbol, in which case it is to be interpreted as a style identifier.
	But I might not be able to draw that kind of border, so it may have to be ignored.
	Or it could be nil, in which case I should revert to the default border."

	| style newStyle |
	style := self borderStyle.
	style baseColor = aColorOrSymbolOrNil
		ifTrue: [^ self].

	aColorOrSymbolOrNil isColor
		ifTrue: [style style = #none "default border?"
				ifTrue: [self borderStyle: (SimpleBorder width: 0 color: aColorOrSymbolOrNil)]
				ifFalse: [style baseColor: aColorOrSymbolOrNil.
					self changed].
			^ self].

	self
		borderStyle: ( ({ nil. #none } includes: aColorOrSymbolOrNil)
				ifTrue: [BorderStyle default]
				ifFalse: [ "a symbol"
					self doesBevels ifFalse: [ ^self ].
					newStyle := (BorderStyle perform: aColorOrSymbolOrNil)
								color: style color;
								width: style width;
								yourself.
					(self canDrawBorder: newStyle)
						ifTrue: [newStyle]
						ifFalse: [style]])! !

!Morph methodsFor: 'accessing' stamp: 'ar 11/26/2001 14:53'!
borderStyle
	^(self valueOfProperty: #borderStyle ifAbsent:[BorderStyle default]) trackColorFrom: self! !

!Morph methodsFor: 'accessing' stamp: 'ar 12/11/2001 22:14'!
borderStyle: newStyle
	newStyle = self borderStyle ifFalse:[
		(self canDrawBorder: newStyle) ifFalse:[
			"Replace the suggested border with a simple one"
			^self borderStyle: (BorderStyle width: newStyle width color: (newStyle trackColorFrom: self) color)].
		self setProperty: #borderStyle toValue: newStyle.
		self changed].! !

!Morph methodsFor: 'accessing' stamp: 'sw 11/26/2001 16:18'!
borderStyleForSymbol: aStyleSymbol
	"Answer a suitable BorderStyle for me of the type represented by a given symbol"

	| aStyle existing |
	aStyle _ BorderStyle borderStyleForSymbol: aStyleSymbol asSymbol.
	aStyle ifNil: [self error: 'bad style'].
	existing _ self borderStyle.
	aStyle width: existing width;
		baseColor: existing baseColor.
	^ (self canDrawBorder: aStyle)
		ifTrue:
			[aStyle]
		ifFalse:
			[nil]! !

!Morph methodsFor: 'accessing' stamp: 'nk 4/14/2004 17:48'!
borderWidth: aNumber
	| style |
	style _ self borderStyle.
	style width = aNumber ifTrue: [ ^self ].

	style style = #none
		ifTrue: [ self borderStyle: (SimpleBorder width: aNumber color: Color transparent) ]
		ifFalse: [ style width: aNumber. self changed ].
! !

!Morph methodsFor: 'e-toy support' stamp: 'RAA 2/5/2001 15:35'!
wrappedInWindowWithTitle: aTitle
	| aWindow w2 |
	aWindow _ (SystemWindow labelled: aTitle) model: Model new.
	aWindow addMorph: self frame: (0@0 extent: 1@1).
	w2 _ aWindow borderWidth * 2.
	w2 _ 3.		"oh, well"
	aWindow extent: self fullBounds extent + (0 @ aWindow labelHeight) + (w2 @ w2).
	^ aWindow! !

!Morph methodsFor: 'fileIn/out' stamp: 'tk 7/11/1998 18:53'!
storeDataOn: aDataStream
	"Let all Morphs be written out.  All owners are weak references.  They only go out if the owner is in the tree being written."
	| cntInstVars cntIndexedVars ti localInstVars |

	"block my owner unless he is written out by someone else"
	cntInstVars _ self class instSize.
	cntIndexedVars _ self basicSize.
	localInstVars _ Morph instVarNames.
	ti _ 2.  
	((localInstVars at: ti) = 'owner') & (Morph superclass == Object) ifFalse:
			[self error: 'this method is out of date'].
	aDataStream
		beginInstance: self class
		size: cntInstVars + cntIndexedVars.
	1 to: ti-1 do:
		[:i | aDataStream nextPut: (self instVarAt: i)].
	aDataStream nextPutWeak: owner.	"owner only written if in our tree"
	ti+1 to: cntInstVars do:
		[:i | aDataStream nextPut: (self instVarAt: i)].
	1 to: cntIndexedVars do:
		[:i | aDataStream nextPut: (self basicAt: i)]! !

!Morph methodsFor: 'geometry' stamp: 'jm 1/29/98 14:26'!
width: aNumber

	self extent: aNumber asInteger@self height.
! !

!Morph methodsFor: 'geometry eToy' stamp: 'sw 10/23/1998 11:50'!
transparentSpacerOfSize: aPoint
	^ (Morph new extent: aPoint) color: Color transparent! !

!Morph methodsFor: 'halos and balloon help' stamp: 'ar 10/10/2000 19:03'!
addHalo: evt
	| halo prospectiveHaloClass |
	prospectiveHaloClass _ Smalltalk at: self haloClass ifAbsent: [HaloMorph].
	halo _ prospectiveHaloClass new bounds: self worldBoundsForHalo.
	halo popUpFor: self event: evt.
	^halo! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sma 11/11/2000 16:15'!
defaultBalloonColor
	^ Display depth <= 2
		ifTrue: [Color white]
		ifFalse: [BalloonMorph balloonColor]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'sd 12/5/2001 20:23'!
defaultBalloonFont
	^ BalloonMorph balloonFont! !

!Morph methodsFor: 'halos and balloon help' stamp: 'bf 11/1/2000 15:58'!
showBalloon: msgString hand: aHand
	"Pop up a balloon containing the given string,
	first removing any existing BalloonMorphs in the world."

	| w balloon h |
	(w _ self world) ifNil: [^ self].
	h _ aHand.
	h ifNil:[
		h _ w activeHand].
	balloon _ BalloonMorph string: msgString for: self balloonHelpAligner.
	balloon popUpFor: self hand: h.! !

!Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:57'!
addCellLayoutMenuItems: aMenu hand: aHand
	"Cell (e.g., child) related items"
	| menu sub |
	menu _ MenuMorph new defaultTarget: self.
		menu addUpdating: #hasDisableTableLayoutString action: #changeDisableTableLayout.
		menu addLine.

		sub _ MenuMorph new defaultTarget: self.
		#(rigid shrinkWrap spaceFill) do:[:sym|
			sub addUpdating: #hResizingString: target: self selector: #hResizing: argumentList: (Array with: sym)].
		menu add:'horizontal resizing' translated subMenu: sub.

		sub _ MenuMorph new defaultTarget: self.
		#(rigid shrinkWrap spaceFill) do:[:sym|
			sub addUpdating: #vResizingString: target: self selector: #vResizing: argumentList: (Array with: sym)].
		menu add:'vertical resizing' translated subMenu: sub.

	aMenu ifNotNil:[aMenu add: 'child layout' translated subMenu: menu].
	^menu! !

!Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 16:51'!
addLayoutMenuItems: topMenu hand: aHand
	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addUpdating: #hasNoLayoutString action: #changeNoLayout.
	aMenu addUpdating: #hasProportionalLayoutString action: #changeProportionalLayout.
	aMenu addUpdating: #hasTableLayoutString action: #changeTableLayout.
	aMenu addLine.
	aMenu add: 'change layout inset...' translated action: #changeLayoutInset:.
	aMenu addLine.
	self addCellLayoutMenuItems: aMenu hand: aHand.
	self addTableLayoutMenuItems: aMenu hand: aHand.
	topMenu ifNotNil:[topMenu add: 'layout' translated subMenu: aMenu].
	^aMenu! !

!Morph methodsFor: 'layout-menu' stamp: 'dgd 8/30/2003 20:07'!
addTableLayoutMenuItems: aMenu hand: aHand
	| menu sub |
	menu _ MenuMorph new defaultTarget: self.
	menu addUpdating: #hasReverseCellsString action: #changeReverseCells.
	menu addUpdating: #hasClipLayoutCellsString action: #changeClipLayoutCells.
	menu addUpdating: #hasRubberBandCellsString action: #changeRubberBandCells.
	menu addLine.
	menu add: 'change cell inset...' translated action: #changeCellInset:.
	menu add: 'change min cell size...' translated action: #changeMinCellSize:.
	menu add: 'change max cell size...' translated action: #changeMaxCellSize:.
	menu addLine.

	sub _ MenuMorph new defaultTarget: self.
	#(leftToRight rightToLeft topToBottom bottomToTop) do:[:sym|
		sub addUpdating: #listDirectionString: target: self selector: #changeListDirection: argumentList: (Array with: sym)].
	menu add: 'list direction' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(none leftToRight rightToLeft topToBottom bottomToTop) do:[:sym|
		sub addUpdating: #wrapDirectionString: target: self selector: #wrapDirection: argumentList: (Array with: sym)].
	menu add: 'wrap direction' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(center topLeft topRight bottomLeft bottomRight topCenter leftCenter rightCenter bottomCenter) do:[:sym|
		sub addUpdating: #cellPositioningString: target: self selector: #cellPositioning: argumentList: (Array with: sym)].
	menu add: 'cell positioning' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(topLeft bottomRight center justified) do:[:sym|
		sub addUpdating: #listCenteringString: target: self selector: #listCentering: argumentList: (Array with: sym)].
	menu add: 'list centering' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(topLeft bottomRight center justified) do:[:sym|
		sub addUpdating: #wrapCenteringString: target: self selector: #wrapCentering: argumentList: (Array with: sym)].
	menu add: 'wrap centering' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(none equal) do:[:sym|
		sub addUpdating: #listSpacingString: target: self selector: #listSpacing: argumentList: (Array with: sym)].
	menu add: 'list spacing' translated subMenu: sub.

	sub _ MenuMorph new defaultTarget: self.
	#(none localRect localSquare globalRect globalSquare) do:[:sym|
		sub addUpdating: #cellSpacingString: target: self selector: #cellSpacing: argumentList: (Array with: sym)].
	menu add: 'cell spacing' translated subMenu: sub.

	aMenu ifNotNil:[aMenu add: 'table layout' translated subMenu: menu].
	^menu! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:08'!
changeCellInset: evt
	| handle |
	handle _ HandleMorph new forEachPointDo:[:newPoint |
		self cellInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:09'!
changeLayoutInset: evt
	| handle |
	handle _ HandleMorph new forEachPointDo:[:newPoint |
		self layoutInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:10'!
changeMaxCellSize: evt
	| handle |
	handle _ HandleMorph new forEachPointDo:[:newPoint |
		self maxCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 11/13/2000 19:10'!
changeMinCellSize: evt
	| handle |
	handle _ HandleMorph new forEachPointDo:[:newPoint |
		self minCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 10/31/2000 19:19'!
changeProportionalLayout
	| layout |
	((layout _ self layoutPolicy) notNil and:[layout isProportionalLayout])
		ifTrue:[^self]. "already proportional layout"
	self layoutPolicy: ProportionalLayout new.
	self layoutChanged.! !

!Morph methodsFor: 'layout-menu' stamp: 'ar 10/31/2000 19:20'!
changeTableLayout
	| layout |
	((layout _ self layoutPolicy) notNil and:[layout isTableLayout])
		ifTrue:[^self]. "already table layout"
	self layoutPolicy: TableLayout new.
	self layoutChanged.! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 17:56'!
assureLayoutProperties
	| props |
	props _ self layoutProperties.
	props == self ifTrue:[props _ nil].
	props ifNil:[
		props _ LayoutProperties new initializeFrom: self.
		self layoutProperties: props].
	^props! !

!Morph methodsFor: 'layout-properties' stamp: 'ar 11/14/2000 17:57'!
assureTableProperties
	| props |
	props _ self layoutProperties.
	props == self ifTrue:[props _ nil].
	props ifNil:[
		props _ TableLayoutProperties new initializeFrom: self.
		self layoutProperties: props].
	props includesTableProperties 
		ifFalse:[self layoutProperties: (props _ props asTableLayoutProperties)].
	^props! !

!Morph methodsFor: 'menus' stamp: 'nk 2/16/2004 13:29'!
addExportMenuItems: aMenu hand: aHandMorph
	"Add export items to the menu"

	aMenu ifNotNil:
		[ | aSubMenu |
		aSubMenu _ MenuMorph new defaultTarget: self.
		aSubMenu add: 'BMP file' translated action: #exportAsBMP.
		aSubMenu add: 'GIF file' translated action: #exportAsGIF.
		aSubMenu add: 'JPEG file' translated action: #exportAsJPEG.
		aSubMenu add: 'PNG file' translated action: #exportAsPNG.
		aMenu add: 'export...' translated subMenu: aSubMenu]
! !

!Morph methodsFor: 'menus' stamp: 'sw 9/6/2000 18:45'!
changeColor
	"Change the color of the receiver -- triggered, e.g. from a menu"

	ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: self activeHand;
		target: self;
		selector: #fillStyle:;
		originalColor: self color;
		putUpFor: self near: self fullBoundsInWorld! !

!Morph methodsFor: 'meta-actions' stamp: 'dgd 8/30/2003 16:42'!
addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
	| menu |
	menu _ MenuMorph new defaultTarget: self.
	self potentialEmbeddingTargets reverseDo: [:m | 
		menu add: (m knownName ifNil:[m class name asString]) target: m selector: #addMorphFrontFromWorldPosition: argumentList: {self}].
	aMenu ifNotNil:[
		menu submorphCount > 0 
			ifTrue:[aMenu add:'embed into' translated subMenu: menu].
	].
	^menu! !

!Morph methodsFor: 'meta-actions' stamp: 'sw 11/27/2001 10:50'!
buildHandleMenu: aHand
	"Build the morph menu for the given morph's halo's menu handle. This menu has two sections. The first section contains commands that are interpreted by the hand; the second contains commands provided by the target morph. This method allows the morph to decide which items should be included in the hand's section of the menu."

	| menu |
	menu _ MenuMorph new defaultTarget: self.
	menu addStayUpItem.
	menu addLine.
	self addStandardHaloMenuItemsTo: menu hand: aHand.
	menu defaultTarget: aHand.
	self addAddHandMenuItemsForHalo: menu  hand: aHand.
	menu defaultTarget: self.
	self addCustomHaloMenuItems: menu hand: aHand.
	menu defaultTarget: aHand.
	^ menu
! !

!Morph methodsFor: 'meta-actions' stamp: 'ar 10/5/2000 18:54'!
changeColorTarget: anObject selector: aSymbol originalColor: aColor hand: aHand
	"Put up a color picker for changing some kind of color.  May be modal or modeless, depending on #modalColorPickers setting"
	self flag: #arNote. "Simplify this due to anObject == self for almost all cases"
	^ ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: aHand;
		target: anObject;
		selector: aSymbol;
		originalColor: aColor;
		putUpFor: anObject near: (anObject isMorph
					ifTrue:	 [Rectangle center: self position extent: 20]
					ifFalse: [anObject == self world
								ifTrue: [anObject viewBox bottomLeft + (20@-20) extent: 200]
								ifFalse: [anObject fullBoundsInWorld]]);
		yourself! !

!Morph methodsFor: 'meta-actions'!
showActions
	"Put up a message list browser of all the code that this morph  
	would run for mouseUp, mouseDown, mouseMove, mouseEnter,  
	mouseLeave, and  
	mouseLinger. tk 9/13/97"
	| list cls selector adder |
	list _ SortedCollection new.
	adder _ [:mrClass :mrSel | list
				add: (MethodReference new setStandardClass: mrClass methodSymbol: mrSel)].
	"the eventHandler"
	self eventHandler
		ifNotNil: [list _ self eventHandler methodRefList.
			(self eventHandler handlesMouseDown: nil)
				ifFalse: [adder value: HandMorph value: #grabMorph:]].
	"If not those, then non-default raw events"
	#(#keyStroke: #mouseDown: #mouseEnter: #mouseLeave: #mouseMove: #mouseUp: #doButtonAction )
		do: [:sel | 
			cls _ self class whichClassIncludesSelector: sel.
			cls
				ifNotNil: ["want more than default behavior"
					cls == Morph
						ifFalse: [adder value: cls value: sel]]].
	"The mechanism on a Button"
	(self respondsTo: #actionSelector)
		ifTrue: ["A button"
			selector _ self actionSelector.
			cls _ self target class whichClassIncludesSelector: selector.
			cls
				ifNotNil: ["want more than default behavior"
					cls == Morph
						ifFalse: [adder value: cls value: selector]]].
	MessageSet openMessageList: list name: 'Actions of ' , self printString! !

!Morph methodsFor: 'stepping and presenter' stamp: 'ar 2/12/2001 17:04'!
step
	"Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.  The generic version dispatches control to the player, if any.  The nasty circumlocation about owner's transformation is necessitated by the flexing problem that the player remains in the properties dictionary both of the flex and the real morph.  In the current architecture, only the top renderer's pointer to the player should actually be honored for the purpose of firing."
! !

!Morph methodsFor: 'structure' stamp: 'sw 7/1/1998 18:02'!
pasteUpMorph
	"Answer the closest containing morph that is a PasteUp morph"
	^ self ownerThatIsA: PasteUpMorph! !

!Morph methodsFor: 'submorphs-accessing'!
submorphsDo: aBlock

	submorphs do: aBlock.! !

!Morph methodsFor: 'text-anchor' stamp: 'ar 12/17/2001 12:45'!
addTextAnchorMenuItems: topMenu hand: aHand
	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addUpdating: #hasInlineAnchorString action: #changeInlineAnchor.
	aMenu addUpdating: #hasParagraphAnchorString action: #changeParagraphAnchor.
	aMenu addUpdating: #hasDocumentAnchorString action: #changeDocumentAnchor.
	topMenu ifNotNil:[topMenu add: 'text anchor' subMenu: aMenu].
	^aMenu! !

!Morph methodsFor: 'visual properties' stamp: 'ar 6/25/1999 11:11'!
defaultColor
	"Return the default fill style for the receiver"
	^Color blue! !

!Morph methodsFor: 'visual properties' stamp: 'ar 6/25/1999 11:11'!
fillStyle
	"Return the current fillStyle of the receiver."
	^self valueOfProperty: #fillStyle ifAbsent:[
		"Workaround already converted morphs"
		color ifNil:[self defaultColor]].! !

!Morph methodsFor: 'stepping'!
wantsSteps
	"Return true if the receiver overrides the default Morph step method."
	"Details: Find first class in superclass chain that implements #step and return true if it isn't class Morph."

	| c |
	c _ self class.
	[c includesSelector: #step] whileFalse: [c _ c superclass].
	^ c ~= Morph! !

!Morph methodsFor: 'property extension' stamp: 'di 8/10/1998 14:25'!
extension
	^ extension! !


!BorderedMorph methodsFor: 'accessing' stamp: 'aoy 2/17/2003 01:19'!
borderStyle
	"Work around the borderWidth/borderColor pair"

	| style |
	borderColor ifNil: [^BorderStyle default].
	borderWidth isZero ifTrue: [^BorderStyle default].
	style := self valueOfProperty: #borderStyle ifAbsent: [BorderStyle default].
	(borderWidth = style width and: 
			["Hah!! Try understanding this..."

			borderColor == style style or: 
					["#raised/#inset etc"

					#simple == style style and: [borderColor = style color]]]) 
		ifFalse: 
			[style := borderColor isColor 
				ifTrue: [BorderStyle width: borderWidth color: borderColor]
				ifFalse: [(BorderStyle perform: borderColor) width: borderWidth	"argh."].
			self setProperty: #borderStyle toValue: style].
	^style trackColorFrom: self! !

!BorderedMorph methodsFor: 'menu' stamp: 'dgd 8/30/2003 16:47'!
addBorderStyleMenuItems: aMenu hand: aHandMorph
	"Add border-style menu items"

	| subMenu |
	subMenu _ MenuMorph new defaultTarget: self.
	subMenu addTitle: 'border' translated.
	subMenu addStayUpItemSpecial.
	subMenu addList: 
		{{'border color...' translated. #changeBorderColor:}.
		{'border width...' translated. #changeBorderWidth:}}.
	subMenu addLine.
	BorderStyle borderStyleChoices do:
		[:sym | (self borderStyleForSymbol: sym)
			ifNotNil:
				[subMenu add: sym target: self selector: #setBorderStyle: argument: sym]].
	aMenu add: 'border style...' translated subMenu: subMenu
! !


!EllipseMorph methodsFor: 'visual properties' stamp: 'ar 6/25/1999 11:14'!
defaultColor
	"Return the default fill style for the receiver"
	^Color yellow! !


!HaloMorph methodsFor: 'handles' stamp: 'ar 10/25/2000 17:48'!
addDismissHandle: handleSpec
	| dismissHandle |
	dismissHandle _ self addHandle: handleSpec
		on: #mouseDown send: #mouseDownInDimissHandle:with: to: self.
	dismissHandle on: #mouseUp send: #maybeDismiss:with: to: self.
	dismissHandle on: #mouseDown send: #setDismissColor:with: to: self.
	dismissHandle on: #mouseMove send: #setDismissColor:with: to: self.
! !

!HaloMorph methodsFor: 'handles' stamp: 'sw 1/26/2000 16:11'!
addGrabHandle: haloSpec
	self addHandle: haloSpec on: #mouseDown send: #doGrab:with: to: self

! !

!HaloMorph methodsFor: 'private' stamp: 'sw 10/6/1999 20:29'!
addGraphicalHandleFrom: formKey at: aPoint
	"Add the supplied form as a graphical handle centered at the given point.  Return the handle."
	| handle aForm |
	aForm _ (ScriptingSystem formAtKey: formKey) ifNil: [ScriptingSystem formAtKey: #SolidMenu].
	handle _ ImageMorph new image: aForm; bounds: (Rectangle center: aPoint extent: aForm extent).
	self addMorph: handle.
	handle on: #mouseUp send: #endInteraction to: self.
	^ handle
! !

!HaloMorph methodsFor: 'private' stamp: 'dgd 8/28/2003 15:15'!
addHandleAt: aPoint color: aColor icon: iconName on: eventName send: selector to: recipient
	"Add a handle centered at the given point with the given color, and set it up to respond to the given event by sending the given selector to the given recipient.  Return the handle."
	| handle |
	handle _ EllipseMorph
		newBounds: (Rectangle center: aPoint extent: self handleSize asPoint)
		color: aColor.
	self addMorph: handle.
	iconName ifNotNil:
		[ | form |
		form _ ScriptingSystem formAtKey: iconName.
		form ifNotNil:
			[handle addMorphCentered: (ImageMorph new
				image: form; 
				color: aColor makeForegroundColor;
				lock)]].
	handle on: #mouseUp send: #endInteraction to: self.
	handle on: eventName send: selector to: recipient.
	handle setBalloonText: (target balloonHelpTextForHandle: handle) translated.
	^ handle
! !


!HandMorph methodsFor: 'accessing' stamp: 'jm 6/11/97 17:26'!
showTemporaryCursor: cursorOrNil
	"Set the temporary cursor to the given Form. If the argument is nil, revert to the normal cursor."

	self showTemporaryCursor: cursorOrNil hotSpotOffset: 0@0.
! !

!HandMorph methodsFor: 'double click support' stamp: 'jcg 9/21/2001 13:19'!
waitForClicksOrDrag: aMorph event: evt selectors: clickAndDragSelectors threshold: threshold
	"Wait until the difference between click, double-click, or drag gesture is known, then inform the given morph what transpired. This message is sent when the given morph first receives a mouse-down event. If the mouse button goes up, then down again within DoubleClickTime, then 'doubleClick: evt' is sent to the morph. If the mouse button goes up but not down again within DoubleClickTime, then the message 'click: evt' is sent to the morph. Finally, if the button does not go up within DoubleClickTime, then 'drag: evt' is sent to the morph. In all cases, the event supplied is the original mouseDown event that initiated the gesture. mouseMove: and mouseUp: events are not sent to the morph until it becomes the mouse focus, which is typically done by the client in its click:, doubleClick:, or drag: methods." 
	mouseClickState _ 
		MouseClickState new
			client: aMorph 
			click: clickAndDragSelectors first 
			dblClick: clickAndDragSelectors second 
			dblClickTime: DoubleClickTime 
			dblClickTimeout: clickAndDragSelectors third
			drag: clickAndDragSelectors fourth 
			threshold: threshold 
			event: evt.! !

!HandMorph methodsFor: 'focus handling' stamp: 'ar 10/6/2000 00:09'!
releaseAllFoci
	mouseFocus _ nil.
	keyboardFocus _ nil.
! !


!MenuLineMorph methodsFor: 'layout' stamp: 'jm 11/4/97 07:46'!
minHeight

	^ 2
! !

!MenuLineMorph methodsFor: 'layout' stamp: 'jm 11/4/97 07:46'!
minWidth

	^ 10
! !


!Morph class methodsFor: 'class initialization'!
initialize
	"Morph initialize"

	"this empty array object is shared by all morphs with no submorphs:"
	EmptyArray _ Array new.
! !


!ImageMorph class methodsFor: 'class initialization' stamp: 'jm 4/10/98 01:09'!
initialize
	"ImageMorph initialize"

	| h p d |
	DefaultForm _ (Form extent: 80@40 depth: 16).
	h _ DefaultForm height // 2.
	0 to: h - 1 do: [:i |
		p _ (i * 2)@i.
		d _ i asFloat / h asFloat.
		DefaultForm fill:
			(p corner: DefaultForm extent - p)
			fillColor: (Color r: d g: 0.5 b: 1.0 - d)].
! !

!ImageMorph class methodsFor: 'instance creation' stamp: 'sw 10/23/2000 18:21'!
fromString: aString font: aFont
	"Create a new ImageMorph showing the given string in the given font"

	^ self new image: (StringMorph contents: aString font: aFont) imageForm! !


!MorphExtension methodsFor: 'named access' stamp: 'di 8/10/1998 12:54'!
eventHandler
	^ eventHandler! !

!MorphExtension methodsFor: 'named access' stamp: 'di 8/10/1998 14:47'!
externalName: newValue
	externalName _ newValue! !

!MorphExtension methodsFor: 'named access' stamp: 'di 8/14/1998 13:07'!
locked
	^ locked! !

!MorphExtension methodsFor: 'named access' stamp: 'di 8/10/1998 12:54'!
locked: newValue
	locked _ newValue! !

!MorphExtension methodsFor: 'named access' stamp: 'di 8/10/1998 12:55'!
sticky: newValue
	sticky _ newValue! !

!MorphExtension methodsFor: 'named access' stamp: 'di 8/14/1998 13:07'!
visible
	^ visible! !

!MorphExtension methodsFor: 'other properties' stamp: 'di 8/11/1998 12:02'!
otherProperties
	^ otherProperties! !

!MorphExtension methodsFor: 'other properties' stamp: 'th 12/15/1999 14:18'!
valueOfProperty: propName 
	^ self valueOfProperty: propName ifAbsent: [nil]! !


!NewParagraph methodsFor: 'composition' stamp: 'RAA 2/25/2001 15:02'!
fixLastWithHeight: lineHeightGuess
"This awful bit is to ensure that if we have scanned all the text and the last character is a CR that there is a null line at the end of lines. Sometimes this was not happening which caused anomalous selections when selecting all the text. This is implemented as a post-composition fixup because I coul;dn't figure out where to put it in the main logic."

	| oldLastLine newRectangle line |

	(text size > 1 and: [text last = Character cr]) ifFalse: [^self].

	oldLastLine _ lines last.
	oldLastLine last - oldLastLine first >= 0 ifFalse: [^self].
	oldLastLine last = text size ifFalse: [^self].

	newRectangle _ oldLastLine left @ oldLastLine bottom 
				extent: 0@(oldLastLine bottom - oldLastLine top).
	"Even though we may be below the bottom of the container,
	it is still necessary to compose the last line for consistency..."

	line _ TextLine start: text size+1 stop: text size internalSpaces: 0 paddingWidth: 0.
	line rectangle: newRectangle.
	line lineHeight: lineHeightGuess baseline: textStyle baseline.
	lines _ lines, (Array with: line).
! !


!PNGReadWriter class methodsFor: 'as yet unclassified' stamp: 'RAA 11/7/2000 09:22'!
createAFormFrom: data

	| error f |

	error _ ''.
	f _ [
		self formFromStream: (RWBinaryOrTextStream with: data)
	] ifError: [ :a :b |
		error _ a printString,'  ',b printString.
		(StringMorph contents: error) color: Color red; imageForm
	].
	^{f. error}! !


!Parser methodsFor: 'public access' stamp: 'tk 2/4/2000 18:39'!
parseArgsAndTemps: aString notifying: req 
	"Parse the argument, aString, notifying req if an error occurs. Otherwise, 
	answer a two-element Array containing Arrays of strings (the argument 
	names and temporary variable names)."

	aString == nil ifTrue: [^#()].
	doitFlag _ false.		"Don't really know if a doit or not!!"
	^self
		initPattern: aString
		notifying: req
		return: [:pattern | (pattern at: 2) , self temporaries]! !

!Parser methodsFor: 'error handling'!
expected: aString 
	"Notify a problem at token 'here'."

	tokenType == #doIt ifTrue: [hereMark _ hereMark + 1].
	hereType == #doIt ifTrue: [hereMark _ hereMark + 1].
	^self notify: aString , ' expected' at: hereMark + requestorOffset! !


!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 1/30/2001 20:37'!
bringWindowsFullOnscreen
	"Make ever SystemWindow on the desktop be totally on-screen, whenever possible."
	
	(SystemWindow windowsIn: self satisfying: [:w | true]) do:
		[:aWindow | 
			aWindow right: (aWindow right min: bounds right).
			aWindow bottom: (aWindow bottom min: bounds bottom).
			aWindow left: (aWindow left max: bounds left).
			aWindow top: (aWindow top max: bounds top)]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/21/2003 17:39'!
closeUnchangedWindows
	"Present a menu of window titles for all windows with changes,
	and activate the one that gets chosen."
	(SelectionMenu confirm:
'Do you really want to close all windows
except those with unaccepted edits?' translated)
		ifFalse: [^ self].

	(SystemWindow windowsIn: self satisfying: [:w | w model canDiscardEdits])
		do: [:w | w delete]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'ar 10/5/2000 17:27'!
collapseAll
	"Collapse all windows"
	(SystemWindow windowsIn: self satisfying: [:w | w isCollapsed not])
		reverseDo: [:w | w collapseOrExpand.  self displayWorld].
	self collapseNonWindows! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'ar 10/5/2000 17:33'!
expandAll
	"Expand all windows"
	(SystemWindow windowsIn: self satisfying: [:w | w isCollapsed])
		reverseDo: [:w | w collapseOrExpand.  self displayWorld]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'sw 3/13/2003 11:51'!
putUpNewMorphMenu
	"Put up the New Morph menu in the world"

	TheWorldMenu new adaptToWorld: self; newMorph! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'dgd 9/19/2003 11:22'!
yellowButtonClickOnDesktopWithEvent: evt 
	"Put up either the personalized menu or the world menu when 
	the user clicks on the morphic desktop with the yellow button. 
	The preference 'personalizedWorldMenu' governs which one 
	is used"
	| aMenu |
	Preferences personalizedWorldMenu
		ifTrue: [aMenu := MenuMorph new defaultTarget: self.
			Preferences personalizeUserMenu: aMenu.
			aMenu addLine.
			aMenu
				add: 'personalize...' translated
				target: Preferences
				action: #letUserPersonalizeMenu]
		ifFalse: [aMenu := self buildWorldMenu: evt.
			aMenu addTitle: 'World' translated].
	aMenu popUpEvent: evt in: self! !

!PasteUpMorph methodsFor: 'world state' stamp: 'ar 9/17/2000 15:33'!
deleteAllHalos
	self haloMorphs do:
		[:m | (m target isKindOf: SelectionMorph) ifTrue: [m target delete].
		m delete].
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'di 9/19/2000 22:17'!
dragThroughOnDesktop: evt
	"Draw out a selection rectangle"
	| selection |
	selection _ SelectionMorph newBounds: (evt cursorPoint extent: 8@8).
	self addMorph: selection.
	^ selection extendByHand: evt hand
! !

!PasteUpMorph methodsFor: 'world state' stamp: 'RAA 5/25/2000 15:12'!
fullRepaintNeeded

	worldState doFullRepaint.
	SystemWindow windowsIn: self
		satisfying: [:w | w makeMeVisible. false].

! !

!PasteUpMorph methodsFor: 'cursor' stamp: 'sw 4/21/1998 16:05'!
cursor
	^ cursor
! !


!Pen methodsFor: 'operations' stamp: 'sw 10/5/2002 02:25'!
arrowHeadFrom: prevPt to: newPt arrowSpec: anArrowSpec
	"Put an arrowhead on the pen stroke from oldPt to newPt"

	| pm af myColor finalPt delta |
	myColor _ self color.
	delta _ newPt - prevPt.
	delta r <= 2 "pixels" ifTrue: [^ self].
	finalPt _ newPt + (Point r: sourceForm width degrees: delta degrees).	"in same direction"
	pm _ PolygonMorph vertices: (Array with: prevPt asIntegerPoint with: finalPt asIntegerPoint)  
		color: myColor  "not used"
		borderWidth: sourceForm width borderColor: myColor.
	pm makeOpen; makeForwardArrow.
	anArrowSpec ifNotNil: [pm arrowSpec: anArrowSpec].
	af _ pm arrowForms first.
	"render it onto the destForm"
	(FormCanvas on: destForm "Display") stencil: af at: af offset + (1@1)
		color: myColor! !


!PenPointRecorder methodsFor: 'line drawing' stamp: 'sma 2/26/2000 19:03'!
drawFrom: p1 to: p2.
	"Overridden to skip drawing but track bounds of the region traversed."

	points ifNil: [points _ OrderedCollection with: p1].
	points addLast: p2! !


!Point methodsFor: 'point functions'!
octantOf: otherPoint
	"Return 1..8 indicating relative direction to otherPoint.
	1=ESE, 2=SSE, ... etc. clockwise to 8=ENE"
	| quad moreHoriz |
	(x = otherPoint x and: [y > otherPoint y]) ifTrue: [^ 6].	"special case"
	(y = otherPoint y and: [x < otherPoint x]) ifTrue: [^ 8].

	quad _ self quadrantOf: otherPoint.
	moreHoriz _ (x - otherPoint x) abs >= (y - otherPoint y) abs.
	(quad even eqv: moreHoriz)
		ifTrue: [^ quad*2]
		ifFalse: [^ quad*2 - 1]! !


!PointerFinder methodsFor: 'morphic ui' stamp: 'sma 6/7/2000 00:09'!
menu: aMenu shifted: shifted
	^ MenuMorph new
		defaultTarget: self;
		add: 'Inspect (i)' action: #inspectObject;
		balloonTextForLastItem: 'Live long and prosper!!';
		addLine;
		add: 'Search again' action: #searchAgain;
		balloonTextForLastItem: 'Search again\for the same object' withCRs;
		yourself! !

!PointerFinder methodsFor: 'morphic ui' stamp: 'RAA 1/7/2001 12:47'!
open
	| window list |
	window _ (SystemWindow labelled: 'Pointer Finder')
		model: self.
	list _ PluggableListMorph new
		doubleClickSelector: #inspectObject;

		on: self
		list: #pointerList
		selected: #pointerListIndex
		changeSelected: #pointerListIndex:
		menu: #menu:shifted:
		keystroke: #arrowKey:from:.
	window addMorph: list frame: (0@0 extent: 1@1).
	list color: Color lightMagenta.
	window openInWorld! !


!PolygonMorph methodsFor: 'editing' stamp: 'ar 3/17/2001 14:32'!
addHandles
	| handle newVert tri |
	self removeHandles.
	handles _ OrderedCollection new.
	tri _ Array with: 0@-4 with: 4@3 with: -3@3.
	vertices withIndexDo:
		[:vertPt :vertIndex |
		handle _ EllipseMorph newBounds: (Rectangle center: vertPt extent: 8@8)
				color: Color yellow.
		handle on: #mouseMove send: #dragVertex:event:fromHandle:
				to: self withValue: vertIndex.
		handle on: #mouseUp send: #dropVertex:event:fromHandle:
				to: self withValue: vertIndex.
		self addMorph: handle.
		handles addLast: handle.
		(closed or: [vertIndex < vertices size]) ifTrue:
			[newVert _ PolygonMorph
					vertices: (tri collect: [:p | p + (vertPt + (vertices atWrap: vertIndex+1) // 2)])
					color: Color green borderWidth: 1 borderColor: Color black.
			newVert on: #mouseDown send: #newVertex:event:fromHandle:
					to: self withValue: vertIndex.
			self addMorph: newVert.
			handles addLast: newVert]].
	smoothCurve ifTrue: [self updateHandles; layoutChanged].
	self changed! !

!PolygonMorph methodsFor: 'editing' stamp: 'nk 8/8/2001 12:13'!
mouseDown: evt

	^ evt shiftPressed
		ifTrue: [((owner isKindOf: PolygonMorph) and: [owner includesHandle: self])
					ifTrue: ["Prevent insertion handles from getting edited"
							^ super mouseDown: evt].
				self toggleHandles.
				handles ifNil: [^ self].
				vertices withIndexDo:  "Check for click-to-drag at handle site"
					[:vertPt :vertIndex |
					((handles at: vertIndex*2-1 ifAbsent: [ ^self ]) containsPoint: evt cursorPoint) ifTrue:
						["If clicked near a vertex, jump into drag-vertex action"
						evt hand newMouseFocus: (handles at: vertIndex*2-1)]]]
		ifFalse: [super mouseDown: evt]! !

!PolygonMorph methodsFor: 'initialization' stamp: 'di 9/7/2000 13:28'!
vertices: verts color: c borderWidth: bw borderColor: bc
	super initialize.
	vertices _ verts.
	color _ c.
	borderWidth _ bw.
	borderColor _ bc.
	closed _ vertices size > 2.
	arrows _ #none.
	self computeBounds.
! !

!PolygonMorph methodsFor: 'menu' stamp: 'md 12/12/2003 16:22'!
customizeArrows: evt
	| handle origin aHand |
	aHand _ evt ifNil: [self primaryHand] ifNotNil: [evt hand].
	origin _ aHand position.
	handle _ HandleMorph new
		forEachPointDo:
			[:newPoint | handle removeAllMorphs.
			handle addMorph:
				(LineMorph from: origin to: newPoint color: Color black width: 1).
			self arrowSpec: (newPoint - origin) / 5.0]
		lastPointDo:
			[:newPoint | handle deleteBalloon.
			self halo ifNotNilDo: [:halo | halo addHandles].].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor left and right
to change arrow length and style.
Move it up and down to change width.
Click when done.' hand: evt hand.
	handle startStepping! !

!PolygonMorph methodsFor: 'visual properties' stamp: 'ar 6/25/1999 11:17'!
defaultColor
	"Return the default fill style for the receiver"
	^Color orange! !


!PolygonMorph class methodsFor: 'instance creation' stamp: 'di 10/18/2001 03:56'!
fromHand: hand
	"Let the user draw a polygon, clicking at each vertex, and ending
		by clicking within 5 of the first point..."
	| p1 poly oldVerts pN opposite |
	Cursor crossHair showWhile:
		[[Sensor anyButtonPressed] whileFalse:
			[self currentWorld displayWorldSafely; runStepMethods].
		p1 _ Sensor cursorPoint].
	opposite _ (Display colorAt: p1) negated.
	opposite = Color transparent ifTrue: [opposite _ Color red].
	(poly _ LineMorph from: p1 to: p1 color: opposite width: 2) openInWorld.
	oldVerts _ {p1}.
	self currentWorld displayWorldSafely; runStepMethods.
	[true] whileTrue:
		[[Sensor anyButtonPressed] whileTrue:
			[pN _ Sensor cursorPoint.
			poly setVertices: (oldVerts copyWith: pN).
			self currentWorld displayWorldSafely; runStepMethods].
		(oldVerts size > 1 and: [(pN dist: p1) < 5]) ifTrue:
			[hand position: Sensor cursorPoint.  "Done -- update hand pos"
			^ (poly setVertices: (poly vertices copyWith: p1)) delete].
		oldVerts _ poly vertices.
		[Sensor anyButtonPressed] whileFalse:
			[pN _ Sensor cursorPoint.
			poly setVertices: (oldVerts copyWith: pN).
			self currentWorld displayWorldSafely; runStepMethods]].
! !


!BalloonMorph class methodsFor: 'private' stamp: 'sd 12/5/2001 20:28'!
getTextMorph: aStringOrMorph for: balloonOwner
	"Construct text morph."
	| m text |
	aStringOrMorph isMorph
		ifTrue: [m _ aStringOrMorph]
		ifFalse: [BalloonFont
				ifNil: [text _ aStringOrMorph]
				ifNotNil: [text _ Text
								string: aStringOrMorph
								attribute: (TextFontReference toFont: balloonOwner balloonFont)].
			m _ (TextMorph new contents: text) centered].
	m setToAdhereToEdge: #adjustedCenter.
	^ m! !


!CurveMorph class methodsFor: 'parts bin' stamp: 'tk 11/14/2001 17:47'!
arrowPrototype

	| aa |
	aa _ PolygonMorph vertices: (Array with: 5@40 with: 5@8 with: 35@8 with: 35@40) 
		color: Color black 
		borderWidth: 2 
		borderColor: Color black.
	aa beSmoothCurve; makeOpen; makeForwardArrow.		"is already open"
	aa dashedBorder: {10. 10. Color red}.
		"A dash spec is a 3- or 5-element array with
		{ length of normal border color.
		length of alternate border color.
		alternate border color}"
	aa computeBounds.
	^ aa! !


!LineMorph class methodsFor: 'as yet unclassified' stamp: 'di 8/20/2000 12:18'!
from: startPoint to: endPoint color: lineColor width: lineWidth

	^ PolygonMorph vertices: {startPoint. endPoint}
			color: Color black borderWidth: lineWidth borderColor: lineColor! !


!PopUpMenu methodsFor: 'accessing'!
center
	"Answer the point at the center of the receiver's rectangular area."

	^frame center! !

!PopUpMenu methodsFor: 'selecting'!
selection
	"Answer the current selection."

	^selection! !


!PopUpMenu class methodsFor: 'instance creation'!
labels: aString
	"Answer an instance of me whose items are in aString."

	^self labels: aString lines: nil! !


!Preferences class methodsFor: 'misc' stamp: 'sw 4/30/2002 00:07'!
browseThemes
	"Open up a message-category browser on the theme-defining methods"

	| aBrowser |
	aBrowser _ Browser new setClass: Preferences class selector: #outOfTheBox..
	aBrowser messageCategoryListIndex: ((Preferences class organization categories indexOf: 'themes' ifAbsent: [^ self inform: 'no themes found']) + 1).
	Browser openBrowserView: (aBrowser openMessageCatEditString: nil)
		label: 'Preference themes'

	"Preferences browseThemes"! !

!Preferences class methodsFor: 'misc' stamp: 'sw 4/30/2002 01:02'!
offerThemesMenu
	"Put up a menu offering the user a choice of themes.  Each theme is represented by a method in category #themes in Preferences class.  The comment at the front of each method is used as the balloon help for the theme"

	"Preferences offerThemesMenu"
	| selectors aMenu |
	selectors _ self class allMethodsInCategory: #themes.
	selectors _ selectors select: [:sel | sel numArgs = 0].
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: 'Choose a theme to install'.
	selectors do:
		[:sel |
			aMenu add: sel target: self selector: #installTheme: argument: sel.
			aMenu balloonTextForLastItem: (self class firstCommentAt: sel)].
	aMenu addLine.
	aMenu add: 'browse themes' target: self action: #browseThemes.
	aMenu balloonTextForLastItem: 'Puts up a tool that will allow you to view and edit the code underlying all of the available themes'.
	aMenu popUpInWorld.
	"(Workspace new contents: 'here is an example of a new window with your new theme installed') openLabel: 'Testing one two three'"! !

!Preferences class methodsFor: 'misc' stamp: 'dgd 9/1/2003 11:43'!
themeChoiceButtonOfColor: aColor font: aFont
	"Answer a button inviting the user to choose a theme"

	| aButton |
	aButton _ SimpleButtonMorph new target: self; actionSelector: #offerThemesMenu.
	aButton label: 'change theme...' translated font: aFont.
	aButton color: aColor.
	aButton setBalloonText: 'Numerous "Preferences" govern many things about the way Squeak looks and behaves.  Set individual preferences using a "Preferences" panel.  Set an entire "theme" of many Preferences all at the same time by pressing this "change theme" button and choosing a theme to install.  Look in category "themes" in Preferences class to see what each theme does; add your own methods to the "themes" category and they will show up in the list of theme choices.' translated.
	^ aButton! !

!Preferences class methodsFor: 'reacting to change' stamp: 'sw 4/12/2001 01:30'!
smartUpdatingChanged
	"The smartUpdating preference changed. React"

	SystemWindow allSubInstancesDo:
		[:aWindow | aWindow amendSteppingStatus]

	"NOTE: This makes this preference always behave like a global preference, which is problematical"! !


!ProcessBrowser methodsFor: 'views' stamp: 'sw 6/13/2001 19:39'!
asPrototypeInWindow
	"Create a pluggable version of me, answer a window"

	| window aTextMorph |
	window _ (SystemWindow labelled: 'later') model: self.
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #processNameList
				selected: #processListIndex
				changeSelected: #processListIndex:
				menu: #processListMenu:
				keystroke: #processListKey:from:)
				enableDragNDrop: false)
		frame: (0 @ 0 extent: 0.5 @ 0.5).
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #stackNameList
				selected: #stackListIndex
				changeSelected: #stackListIndex:
				menu: #stackListMenu:
				keystroke: #stackListKey:from:)
				enableDragNDrop: false)
		frame: (0.5 @ 0.0 extent: 0.5 @ 0.5).
	aTextMorph _ PluggableTextMorph
				on: self
				text: #selectedMethod
				accept: nil
				readSelection: nil
				menu: nil.
	window
		addMorph: aTextMorph
		frame: (0 @ 0.5 corner: 1 @ 1).
	window setLabel: 'Process Browser'.
	^ window! !

!ProcessBrowser methodsFor: 'views' stamp: 'nk 3/14/2001 09:04'!
openAsMorph
	"Create a pluggable version of me, answer a window"
	| window aTextMorph |
	window _ (SystemWindow labelled: 'later')
				model: self.

	deferredMessageRecipient _ WorldState.
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #processNameList
				selected: #processListIndex
				changeSelected: #processListIndex:
				menu: #processListMenu:
				keystroke: #processListKey:from:)
				enableDragNDrop: false)
		frame: (0 @ 0 extent: 0.5 @ 0.5).
	window
		addMorph: ((PluggableListMorph
				on: self
				list: #stackNameList
				selected: #stackListIndex
				changeSelected: #stackListIndex:
				menu: #stackListMenu:
				keystroke: #stackListKey:from:)
				enableDragNDrop: false)
		frame: (0.5 @ 0.0 extent: 0.5 @ 0.5).
	aTextMorph _ PluggableTextMorph
				on: self
				text: #selectedMethod
				accept: nil
				readSelection: nil
				menu: nil.
	aTextMorph askBeforeDiscardingEdits: false.
	window
		addMorph: aTextMorph
		frame: (0 @ 0.5 corner: 1 @ 1).
	window setUpdatablePanesFrom: #(#processNameList #stackNameList ).
	(window setLabel: 'Process Browser') openInWorld.
	startedCPUWatcher ifTrue: [ self setUpdateCallbackAfter: 7 ].
	^ window! !


!RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'RAA 6/14/2000 19:22'!
assignCollapseFrameFor: aSSView 
        "Offer up a location along the left edge of the screen for a collapsed SSView. Make sure it doesn't overlap any other collapsed frames."
        | grid otherFrames topLeft viewBox collapsedFrame extent newFrame verticalBorderDistance top |
        grid _ 8.
        verticalBorderDistance _ 8.
        aSSView isMorph ifTrue: [
                otherFrames _ (SystemWindow windowsIn: aSSView world satisfying: [:w | w ~= aSSView])
                                                collect: [:w | w collapsedFrame]
                                                thenSelect: [:rect | rect notNil].
                        viewBox _ aSSView world viewBox]
                ifFalse: 
                        [otherFrames _ ScheduledControllers scheduledWindowControllers
                                                collect: [:aController | aController view ~= aSSView ifTrue: [aController view collapsedFrame]]
                                                thenSelect: [:rect | rect notNil].
                        viewBox _ Display boundingBox].
        collapsedFrame _ aSSView collapsedFrame.
        extent _ collapsedFrame notNil
                                ifTrue: [collapsedFrame extent]
                                ifFalse: [aSSView isMorph
                                        ifTrue: [aSSView getRawLabel width + aSSView labelWidgetAllowance @ (aSSView labelHeight + 2)]
                                        ifFalse: [(aSSView labelText extent x + 70) @ aSSView labelHeight
                                                        min: aSSView labelDisplayBox extent
                                        ]
                                ].
        collapsedFrame notNil
                ifTrue: [(otherFrames anySatisfy: [:f | collapsedFrame intersects: f])
                                ifFalse: ["non overlapping"
                                        ^ collapsedFrame]].
        top _ viewBox top + verticalBorderDistance.
        [topLeft _ viewBox left @ top.
        newFrame _ topLeft extent: extent.
        newFrame bottom <= (viewBox height - verticalBorderDistance)]
                whileTrue: 
                        [(otherFrames anySatisfy: [:w | newFrame intersects: w])
                                ifFalse: ["no overlap"
                                        ^ newFrame].
                        top _ top + grid].
        "If all else fails... (really to many wins here)"
        ^ 0 @ 0 extent: extent! !

!RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'RAA 6/14/2000 19:22'!
assignCollapsePointFor: aSSView
        "Offer up a location along the left edge of the screen for a collapsed SSView.
        Make sure it doesn't overlap any other collapsed frames."
        | grid otherFrames y free topLeft viewBox |
        grid _ 24.  "should be mult of 8, since manual move is gridded by 8"
        aSSView isMorph
                ifTrue: [otherFrames _ (SystemWindow windowsIn: aSSView world satisfying: [:w | true])
                                        collect: [:w | w collapsedFrame]
                                        thenSelect: [:rect | rect notNil].
                                viewBox _ aSSView world viewBox]
                ifFalse: [otherFrames _ ScheduledControllers scheduledWindowControllers
                                        collect: [:aController | aController view collapsedFrame]
                                        thenSelect: [:rect | rect notNil].
                                viewBox _ Display boundingBox].
        y _ viewBox top.
        [(y _ y + grid) <= (viewBox height - grid)]
                whileTrue:
                [topLeft _ viewBox left@y.
                free _ true.
                otherFrames do: [:w | free _ free & (topLeft ~= w topLeft)].
                free ifTrue: [^ topLeft]].
        "If all else fails..."
        ^ 0 @ 0! !


!RectangleMorph methodsFor: 'initialization' stamp: 'tk 11/6/2001 08:20'!
defaultColor
	"Answer the color that should be set for the receiver by default"

	^ Color r: 0.613 g: 0.903 b: 1.0! !


!AlignmentMorph methodsFor: 'initialization' stamp: 'dgd 2/14/2003 19:19'!
initialize
	"initialize the state of the receiver"
	super initialize.
	""
	self layoutPolicy: TableLayout new;
	 listDirection: #leftToRight;
	 wrapCentering: #topLeft;
	 hResizing: #spaceFill;
	 vResizing: #spaceFill;
	 layoutInset: 2;
	 rubberBandCells: true! !


!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'dgd 4/28/2003 21:07'!
createQueryTextMorph: queryString 
	"create the queryTextMorph"
	| result frame |
	result := TextMorph new contents: queryString.
	result setNameTo: 'query'.
	result lock.
	frame := LayoutFrame new.
	frame topFraction: 0.0;
		 topOffset: 2.
	frame leftFraction: 0.5;
		 leftOffset: (result width // 2) negated.
	result layoutFrame: frame.
	self addMorph: result.
	^ result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'sd 11/8/2003 15:56'!
createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean topOffset: topOffset buttonAreaHeight: buttonAreaHeight 
	"create the textPane"
	| result frame |
	result := PluggableTextMorph
				on: self
				text: #response
				accept: #response:
				readSelection: #selectionInterval
				menu: #codePaneMenu:shifted:.
	result extent: answerExtent.
	result hResizing: #spaceFill;
		 vResizing: #spaceFill.
	result borderWidth: 1.
	result hasUnacceptedEdits: true.
	result acceptOnCR: acceptBoolean.
	result setNameTo: 'textPane'.
	frame := LayoutFrame new.
	frame leftFraction: 0.0;
		 rightFraction: 1.0;
		 topFraction: 0.0;
		 topOffset: topOffset;
		 bottomFraction: 1.0;
		 bottomOffset: buttonAreaHeight negated.
	result layoutFrame: frame.
	self addMorph: result.
	^ result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'sd 11/8/2003 15:58'!
setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean 
	| query topOffset accept cancel buttonAreaHeight |
	response := initialAnswer.
	done := false.
	self removeAllMorphs.
	self layoutPolicy: ProportionalLayout new.
	query := self createQueryTextMorph: queryString.
	topOffset := query height + 4.
	accept := self createAcceptButton.
	cancel := self createCancelButton.
	buttonAreaHeight := (accept height max: cancel height)
				+ 4.
	textPane := self
				createTextPaneExtent: answerExtent
				acceptBoolean: acceptBoolean
				topOffset: topOffset
				buttonAreaHeight: buttonAreaHeight.
	self extent: (query extent x max: answerExtent x)
			+ 4 @ (topOffset + answerExtent y + 4 + buttonAreaHeight).
	! !


!GraphicalMenu methodsFor: 'as yet unclassified' stamp: 'dgd 2/14/2003 19:08'!
initializeFor: aTarget withForms: formList coexist: aBoolean 
	"World primaryHand attachMorph: (GraphicalMenu new  
	initializeFor: nil  
	withForms: Form allInstances coexist: true)"
	| buttons bb anIndex buttonCage imageWrapper |
	target _ aTarget.
	coexistWithOriginal _ aBoolean.

	formChoices _ formList.
	currentIndex _ 1.
	self hResizing: #shrinkWrap;
		 vResizing: #shrinkWrap.
	buttons _ AlignmentMorph newRow.
	buttons borderWidth: 0;
		 layoutInset: 0.
	buttons hResizing: #shrinkWrap;
		 vResizing: #shrinkWrap;
		 extent: 5 @ 5.
	buttons wrapCentering: #topLeft.
	buttonCage _ AlignmentMorph newColumn.
	buttonCage hResizing: #shrinkWrap;
		 vResizing: #spaceFill.
	buttonCage addTransparentSpacerOfSize: 0 @ 10.
	bb _ SimpleButtonMorph new target: self;
				 borderColor: Color black.
	buttons addMorphBack: (bb label: 'Prev';
			 actionSelector: #downArrowHit;
			 actWhen: #whilePressed).
	buttons addTransparentSpacerOfSize: 9 @ 0.
	bb _ SimpleButtonMorph new target: self;
				 borderColor: Color black.
	buttons addMorphBack: (bb label: 'Next';
			 actionSelector: #upArrowHit;
			 actWhen: #whilePressed).
	buttons addTransparentSpacerOfSize: 5 @ 0.
	buttons submorphs last color: Color white.
	buttonCage addMorphBack: buttons.
	buttonCage addTransparentSpacerOfSize: 0 @ 12.
	buttons _ AlignmentMorph newRow.
	bb _ SimpleButtonMorph new target: self;
				 borderColor: Color black.
	buttons addMorphBack: (bb label: 'OK';
			 actionSelector: #okay).
	buttons addTransparentSpacerOfSize: 5 @ 0.
	bb _ SimpleButtonMorph new target: self;
				 borderColor: Color black.
	buttons addMorphBack: (bb label: 'Cancel';
			 actionSelector: #cancel).
	buttonCage addMorphBack: buttons.
	buttonCage addTransparentSpacerOfSize: 0 @ 10.
	self addMorphFront: buttonCage.
	imageWrapper _ Morph new color: Color transparent;
				 extent: 102 @ 82.
	imageWrapper addMorphBack: (formDisplayMorph _ ImageMorph new extent: 100 @ 100).
	self addMorphBack: imageWrapper.
	target
		ifNotNil: [(anIndex _ formList
						indexOf: target form
						ifAbsent: [])
				ifNotNil: [currentIndex _ anIndex]].
	self updateThumbnail! !


!GraphicalDictionaryMenu class methodsFor: 'instance creation' stamp: 'sd 5/11/2003 20:58'!
openOn: aFormDictionary withLabel: aLabel
	"open a graphical dictionary in a window having the label aLabel. 
     aFormDictionary should be a dictionary containing as value a form."

	| inst |
	aFormDictionary size isZero ifTrue: [^ self inform: 'Empty!!'].	
	inst := self new initializeFor: nil fromDictionary: aFormDictionary.
     HandMorph attach: (inst wrappedInWindowWithTitle: aLabel).
	^ inst! !


!MenuMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
items

	^ submorphs select: [:m | m isKindOf: MenuItemMorph]
! !

!MenuMorph methodsFor: 'accessing' stamp: 'nk 6/8/2004 16:52'!
lastItem
	^ submorphs reverse
		detect: [ :m | m isKindOf: MenuItemMorph ]
		ifNone: [ submorphs last ]! !

!MenuMorph methodsFor: 'accessing' stamp: 'jm 11/4/97 07:46'!
popUpOwner: aMenuItemMorph

	popUpOwner _ aMenuItemMorph.
! !

!MenuMorph methodsFor: 'construction' stamp: 'jm 11/4/97 07:46'!
add: aString subMenu: aMenuMorph
	"Append the given submenu with the given label."

	| item |
	item _ MenuItemMorph new.
	item contents: aString;
		subMenu: aMenuMorph.
	self addMorphBack: item.
! !

!MenuMorph methodsFor: 'construction' stamp: 'ar 12/16/2001 16:53'!
add: aString subMenu: aMenuMorph target: target selector: aSymbol argumentList: argList
	"Append the given submenu with the given label."

	| item |
	item _ MenuItemMorph new.
	item 
		contents: aString;
		target: target;
		selector: aSymbol;
		arguments: argList asArray;
		subMenu: aMenuMorph.
	self addMorphBack: item.
	^item! !

!MenuMorph methodsFor: 'construction' stamp: 'sw 11/6/2000 13:44'!
add: aString target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  Answer the appended menu item."

	| item |
	item _ MenuItemMorph new
		contents: aString;
		target: target;
		selector: aSymbol;
		arguments: argList asArray.
	self addMorphBack: item.
	^ item
! !

!MenuMorph methodsFor: 'construction' stamp: 'jm 5/20/1998 10:50'!
addLine
	"Append a divider line to this menu. Suppress duplicate lines."

	submorphs isEmpty ifTrue: [^ self].
	(self lastSubmorph isKindOf: MenuLineMorph)
		ifFalse: [self addMorphBack: MenuLineMorph new].
! !

!MenuMorph methodsFor: 'construction' stamp: 'dgd 3/22/2003 19:27'!
addStayUpIcons
	| title closeBox pinBox |
	title := submorphs
				detect: [:ea | ea hasProperty: #titleString]
				ifNone: [self setProperty: #needsTitlebarWidgets toValue: true.
					^ self].
	closeBox := IconicButton new target: self;
				 actionSelector: #delete;
				 labelGraphic: self class closeBoxImage;
				 color: Color transparent;
				 extent: 14 @ 16;
				 borderWidth: 0.
	pinBox := IconicButton new target: self;
				 actionSelector: #stayUp:;
				 arguments: {true};
				 labelGraphic: self class pushPinImage;
				 color: Color transparent;
				 extent: 14 @ 15;
				 borderWidth: 0.
	Preferences noviceMode
		ifTrue: [closeBox setBalloonText: 'close this menu'.
			pinBox setBalloonText: 'keep this menu up'].
	self addMorphFront: (AlignmentMorph newRow vResizing: #shrinkWrap;
			 layoutInset: 0;
			 color: Color transparent"Preferences menuTitleColor";
			 addMorphBack: closeBox;
			 addMorphBack: title;
			 addMorphBack: pinBox).
	self setProperty: #hasTitlebarWidgets toValue: true.
	self removeProperty: #needsTitlebarWidgets.
	self removeStayUpItems! !

!MenuMorph methodsFor: 'construction' stamp: 'sw 11/6/2000 13:39'!
addUpdating: wordingSelector enablementSelector: enablementSelector target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the wording of the menu item is obtained by sending the wordingSelector to the target, and the optional enablementSelector determines whether or not the item should be enabled.  Answer the item itself."

	| item |
	item _ UpdatingMenuItemMorph new
		target: target;
		selector: aSymbol;
		wordingProvider: target wordingSelector: wordingSelector;
		enablementSelector: enablementSelector;
		arguments: argList asArray.
	self addMorphBack: item.
	^ item
! !

!MenuMorph methodsFor: 'construction' stamp: 'sw 11/6/2000 13:43'!
addUpdating: wordingSelector target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the wording of the menu item is obtained by sending the wordingSelector to the target,  Answer the item added."

	| item |
	item _ UpdatingMenuItemMorph new
		target: target;
		selector: aSymbol;
		wordingProvider: target wordingSelector: wordingSelector;
		arguments: argList asArray.
	self addMorphBack: item.
	^ item
! !

!MenuMorph methodsFor: 'construction' stamp: 'sw 8/28/2000 18:01'!
addWithLabel: aLabel enablementSelector: enablementSelector target: target selector: aSymbol argumentList: argList
	"Append a menu item with the given label. If the item is selected, it will send the given selector to the target object with the given arguments. If the selector takes one more argument than the number of arguments in the given list, then the triggering event is supplied as as the last argument.  In this variant, the wording of the menu item is constant, and the optional enablementSelector determines whether or not the item should be enabled."

	| item |
	item _ UpdatingMenuItemMorph new
		target: target;
		selector: aSymbol;
		contents: aLabel;
		wordingProvider: target wordingSelector: nil;
		enablementSelector: enablementSelector;
		arguments: argList asArray.
	self addMorphBack: item.
! !

!MenuMorph methodsFor: 'control' stamp: 'jm 11/4/97 07:46'!
deleteIfPopUp
	"Remove this menu from the screen if stayUp is not true. If it is a submenu, also remove its owning menu."

	stayUp ifFalse: [self delete].
	(popUpOwner notNil and: [popUpOwner isKindOf: MenuItemMorph]) ifTrue: [
		popUpOwner isSelected: false.
		(popUpOwner owner isKindOf: MenuMorph)
			ifTrue: [popUpOwner owner deleteIfPopUp]].
! !

!MenuMorph methodsFor: 'control' stamp: 'ar 9/18/2000 12:15'!
popUpAdjacentTo: rightOrLeftPoint forHand: hand from: sourceItem
	"Present this menu at the given point under control of the given hand."

	| delta tryToPlace selectedOffset |

	hand world startSteppingSubmorphsOf: self.
	popUpOwner _ sourceItem.
	self fullBounds.  "ensure layout is current"
	selectedOffset := (selectedItem ifNil:[self items first]) position - self position.

	tryToPlace :=
		[ :where :mustFit |
		self position: where - selectedOffset.
		delta _ self fullBoundsInWorld amountToTranslateWithin: sourceItem worldBounds.
		(delta x = 0 or: [mustFit]) ifTrue:
			[delta = (0@0) ifFalse: [self position: self position + delta].
			sourceItem owner owner addMorphFront: self.
			^ self]].
	tryToPlace 
		value: rightOrLeftPoint first value: false;
		value: rightOrLeftPoint last  - (self width @ 0) value: false;
		value: rightOrLeftPoint first value: true

	! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'laza 5/6/2004 13:59'!
keyStroke: evt 
	| matchString char asc selectable help |
	help _ BalloonMorph string: 'Enter text to\narrow selection down\to matching items ' withCRs for: self corner: #topLeft.
	help popUpForHand: self activeHand.
	(self rootMenu hasProperty: #hasUsedKeyboard) 
		ifFalse: 
			[self rootMenu setProperty: #hasUsedKeyboard toValue: true.
			self changed].
	(evt commandKeyPressed and: [self commandKeyHandler notNil]) 
		ifTrue: 
			[self commandKeyHandler commandKeyTypedIntoMenu: evt.
			^self deleteIfPopUp: evt].
	char := evt keyCharacter.
	asc := char asciiValue.
	char = Character cr 
		ifTrue: 
			[selectedItem ifNotNil: 
					[selectedItem hasSubMenu 
						ifTrue: 
							[evt hand newMouseFocus: selectedItem subMenu.
							^evt hand newKeyboardFocus: selectedItem subMenu]
						ifFalse: 
							["self delete."

							^selectedItem invokeWithEvent: evt]].
			(selectable := self items) size = 1 
				ifTrue: [^selectable first invokeWithEvent: evt].
			^self].
	asc = 27 
		ifTrue: 
			["escape key"

			self valueOfProperty: #matchString
				ifPresentDo: 
					[:str | 
					str isEmpty 
						ifFalse: 
							["If filtered, first ESC removes filter"

							self setProperty: #matchString toValue: String new.
							self selectItem: nil event: evt.
							^self displayFiltered: evt]].
			"If a stand-alone menu, just delete it"
			popUpOwner ifNil: [^self delete].
			"If a sub-menu, then deselect, and return focus to outer menu"
			self selectItem: nil event: evt.
			evt hand newMouseFocus: popUpOwner owner.
			^evt hand newKeyboardFocus: popUpOwner owner].
	(asc = 28 or: [asc = 29]) 
		ifTrue: 
			["left or right arrow key"

			(selectedItem notNil and: [selectedItem hasSubMenu]) 
				ifTrue: 
					[evt hand newMouseFocus: selectedItem subMenu.
					selectedItem subMenu moveSelectionDown: 1 event: evt.
					^evt hand newKeyboardFocus: selectedItem subMenu]].
	asc = 30 ifTrue: [^self moveSelectionDown: -1 event: evt].	"up arrow key"
	asc = 31 ifTrue: [^self moveSelectionDown: 1 event: evt].	"down arrow key"
	asc = 11 ifTrue: [^self moveSelectionDown: -5 event: evt].	"page up key"
	asc = 12 ifTrue: [^self moveSelectionDown: 5 event: evt].	"page down key"
	matchString := self valueOfProperty: #matchString ifAbsentPut: [String new].
	matchString := char = Character backspace 
				ifTrue: 
					[matchString isEmpty ifTrue: [matchString] ifFalse: [matchString allButLast]]
				ifFalse: [matchString copyWith: evt keyCharacter].
	self setProperty: #matchString toValue: matchString.
	self displayFiltered: evt.
	help _ BalloonMorph string: 'Enter text to\narrow selection down\to matching items ' withCRs for: self corner: #topLeft.
	help popUpForHand: self activeHand.
! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'di 12/10/2001 22:52'!
moveSelectionDown: direction event: evt
	"Move the current selection up or down by one, presumably under keyboard control.
	direction = +/-1"

	| index m |
	index _ (submorphs indexOf: selectedItem ifAbsent: [1-direction]) + direction.
	submorphs do: "Ensure finite"
		[:unused | m _ submorphs atWrap: index.
		((m isKindOf: MenuItemMorph) and: [m isEnabled]) ifTrue:
			[^ self selectItem: m event: evt].
		"Keep looking for an enabled item"
		index _ index + direction sign].
	^ self selectItem: nil event: evt! !

!MenuMorph methodsFor: 'menu' stamp: 'jm 11/4/97 07:46'!
detachSubMenu: evt

	| possibleTargets item subMenu |
	possibleTargets _ evt hand argumentOrNil morphsAt: evt hand targetOffset.
	item _ possibleTargets detect: [:each | each isKindOf: MenuItemMorph] ifNone: [^ self].
	subMenu _ item subMenu.
	subMenu ifNotNil: [
		item subMenu: nil.
		item delete.
		subMenu stayUp: true.
		subMenu popUpOwner: nil.
		subMenu addTitle: item contents.
		evt hand attachMorph: subMenu].
! !

!MenuMorph methodsFor: 'menu' stamp: 'gm 2/22/2003 13:10'!
removeStayUpBox
	| box |
	submorphs isEmpty ifTrue: [^self].
	(submorphs first isAlignmentMorph) ifFalse: [^self].
	box := submorphs first submorphs last.
	(box isKindOf: IconicButton) 
		ifTrue: 
			[box
				labelGraphic: (Form extent: box extent depth: 8);
				shedSelvedge;
				borderWidth: 0;
				lock]! !


!MenuMorph class methodsFor: 'example' stamp: 'jm 11/4/97 07:46'!
example
	"MenuMorph example"

	| menu |
	menu _ MenuMorph new.
	menu addStayUpItem.
	menu add: 'apples' action: #apples.
	menu add: 'oranges' action: #oranges.
	menu addLine.
	menu addLine.  "extra lines ignored"
	menu add: 'peaches' action: #peaches.
	menu addLine.
	menu add: 'pears' action: #pears.
	menu addLine.
	^ menu
! !


!PluggableButtonMorph methodsFor: 'accessing' stamp: 'ar 11/9/2000 21:21'!
label: aStringOrTextOrMorph
	"Label this button with the given string or morph."

	| r |
	self removeAllMorphs.
	"nest label in a row for centering"
	r _ AlignmentMorph newRow
		borderWidth: 0;
		layoutInset: 0;
		color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		wrapCentering: #center; cellPositioning: #leftCenter.
	aStringOrTextOrMorph isMorph
		ifTrue: [
			label _ aStringOrTextOrMorph.
			r addMorph: aStringOrTextOrMorph]
		ifFalse: [
			label _ aStringOrTextOrMorph asString.
			r addMorph: (StringMorph contents: label)].
	self addMorph: r.
! !

!PluggableButtonMorph methodsFor: 'accessing' stamp: 'sw 7/30/2001 15:55'!
label: aStringOrTextOrMorph font: aFont
	"Label this button with the given string or morph."

	| r |
	self removeAllMorphs.
	"nest label in a row for centering"
	r _ AlignmentMorph newRow
		borderWidth: 0;
		layoutInset: 0;
		color: Color transparent;
		hResizing: #shrinkWrap;
		vResizing: #spaceFill;
		wrapCentering: #center; cellPositioning: #leftCenter.
	aStringOrTextOrMorph isMorph
		ifTrue: [
			label _ aStringOrTextOrMorph.
			r addMorph: aStringOrTextOrMorph]
		ifFalse: [
			label _ aStringOrTextOrMorph asString.
			r addMorph: (StringMorph contents: label font: aFont)].
	self addMorph: r.
! !


!PluggableButtonMorph class methodsFor: 'example' stamp: 'RAA 1/17/2001 14:32'!
example
	"PluggableButtonMorph example openInWorld"

	| s1 s2 s3 b1 b2 b3 row |
	s1 _ Switch new.
	s2 _ Switch new turnOn.
	s3 _ Switch new.
	s2 onAction: [s3 turnOff].
	s3 onAction: [s2 turnOff].
	b1 _ (PluggableButtonMorph on: s1 getState: #isOn action: #switch) label: 'S1'.
	b2 _ (PluggableButtonMorph on: s2 getState: #isOn action: #turnOn) label: 'S2'.
	b3 _ (PluggableButtonMorph on: s3 getState: #isOn action: #turnOn) label: 'S3'.
	b1
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	b2
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	b3
		hResizing: #spaceFill;
		vResizing: #spaceFill.

	row _ AlignmentMorph newRow
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		addAllMorphs: (Array with: b1 with: b2 with: b3);
		extent: 120@35.
	^ row
! !


!ProgressMorph methodsFor: 'initialization' stamp: 'sma 3/3/2000 19:13'!
initLabelMorph
	^ labelMorph _ StringMorph contents: '' font: (self fontOfPointSize: 14)! !

!ProgressMorph methodsFor: 'initialization' stamp: 'dvf 9/17/2003 05:14'!
initProgressMorph
	progress := ProgressBarMorph new.
	progress borderWidth: 1.
	progress color: Color white.
	progress progressColor: Color gray.
	progress extent: 200 @ 15.
! !

!ProgressMorph methodsFor: 'initialization' stamp: 'sma 3/3/2000 19:13'!
initSubLabelMorph
	^ subLabelMorph _ StringMorph contents: '' font: (self fontOfPointSize: 12)! !

!ProgressMorph methodsFor: 'initialization' stamp: 'nk 4/21/2002 20:06'!
setupMorphs
	|  |
	self initProgressMorph.
	self	
		layoutPolicy: TableLayout new;
		listDirection: #topToBottom;
		cellPositioning: #topCenter;
		listCentering: #center;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		color: Color transparent.

	self addMorphBack: self labelMorph.
	self addMorphBack: self subLabelMorph.
	self addMorphBack: self progress.

	self borderWidth: 2.
	self borderColor: Color black.

	self color: Color veryLightGray.
	self align: self fullBounds center with: Display boundingBox center
! !


!ProgressMorph class methodsFor: 'example' stamp: 'sma 3/3/2000 19:07'!
example
	"ProgressMorph example"

	| progress |
	progress _ ProgressMorph label: 'Test progress'.
	progress subLabel: 'this is the subheading'.
	progress openInWorld.
	[10 timesRepeat:
		[(Delay forMilliseconds: 200) wait.
		progress incrDone: 0.1].
	progress delete] fork! !


!ReturnNode methodsFor: 'printing'!
printOn: aStream indent: level

	aStream nextPutAll: '^ '.
	expr printOn: aStream indent: level.
	expr printCommentOn: aStream indent: level! !


!ReverbSound methodsFor: 'sound generation' stamp: 'jm 1/21/98 15:00'!
mixSampleCount: n into: aSoundBuffer startingAt: startIndex leftVol: leftVol rightVol: rightVol
	"Play my sound with reberberation."

	sound mixSampleCount: n
		into: aSoundBuffer
		startingAt: startIndex
		leftVol: leftVol
		rightVol: rightVol.
	self applyReverbTo: aSoundBuffer startingAt: startIndex count: n.
! !


!SampledSound methodsFor: 'sound tracks' stamp: 'di 9/6/2000 20:48'!
sonogramMorph: height from: start to: stop nPoints: nPoints
	"FYI:  It is very cool that we can do this, but for sound tracks on a movie,
	simple volume is easier to read, easier to scale, and way faster to compute.
	Code preserved here just in case it makes a useful example."
	"In an inspector of a samplesSound...
		self currentWorld addMorph: (self sonogramMorph: 32 from: 1 to: 50000 nPoints: 256)
	"
	| fft sonogramMorph data width |
	fft _ FFT new: nPoints.
	width _ stop-start//nPoints.
	sonogramMorph _ Sonogram new
			extent: width@height
			minVal: 0.0
			maxVal: 1.0
			scrollDelta: width.
	start to: stop-nPoints by: nPoints do:
		[:i |
		data _ fft transformDataFrom: samples startingAt: i.
		data _ data collect: [:v | v sqrt].  "square root compresses dynamic range"
		data /= 200.0.
		sonogramMorph plotColumn: data].
	^ sonogramMorph
	
! !


!ScorePlayer methodsFor: 'sound generation' stamp: 'di 10/22/2000 17:19'!
jumpToTick: startTick

	| |
	self reset.
	self processTempoMapAtTick: startTick.
	self skipNoteEventsThruTick: startTick.
	self skipAmbientEventsThruTick: startTick.
	ticksSinceStart _ startTick.
! !


!ScrollPane methodsFor: 'access' stamp: 'dew 3/23/2002 01:20'!
flatColoredScrollBarLook
	"Currently only show the flat (not rounded) + colored-to-match-window scrollbar look when inboard."
	^ Preferences alternativeScrollbarLook and: [retractableScrollBar not or: [ScrollBar alwaysShowFlatScrollbarForAlternativeLook]]
! !

!ScrollPane methodsFor: 'initialization' stamp: 'sps 3/9/2004 18:02'!
hInitScrollBarTEMPORARY
"This is called lazily before the hScrollBar is accessed in a couple of places. It is provided to transition old ScrollPanes lying around that do not have an hScrollBar. Once it has been in the image for awhile, and all ScrollPanes have an hScrollBar, this method and it's references can be removed. "

		"Temporary method for filein of changeset"
		hScrollBar ifNil: 
			[hScrollBar := ScrollBar new model: self slotName: 'hScrollBar'.
			hScrollBar borderWidth: 1; borderColor: Color black.
			self 
				resizeScrollBars;
				setScrollDeltas;
				hideOrShowScrollBars].
! !

!ScrollPane methodsFor: 'menu' stamp: 'sw 9/23/1998 08:47'!
getMenu: shiftKeyState
	"Answer the menu for this text view, supplying an empty menu to be filled in. If the menu selector takes an extra argument, pass in the current state of the shift key."
	| menu aMenu aTitle |
	getMenuSelector == nil ifTrue: [^ nil].
	menu _ MenuMorph new defaultTarget: model.
	aTitle _ getMenuTitleSelector ifNotNil: [model perform: getMenuTitleSelector].
	getMenuSelector numArgs = 1 ifTrue:
		[aMenu _ model perform: getMenuSelector with: menu.
		aTitle ifNotNil:  [aMenu addTitle: aTitle].
		^ aMenu].
	getMenuSelector numArgs = 2 ifTrue:
		[aMenu _ model perform: getMenuSelector with: menu with: shiftKeyState.
		aTitle ifNotNil:  [aMenu addTitle: aTitle].
		^ aMenu].
	^ self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! !

!ScrollPane methodsFor: 'pane events' stamp: 'di 5/7/1998 11:46'!
mouseMove: evt
	"If pane is not full, pass the event to the last submorph,
	assuming it is the most appropriate recipient (!!)"
	scroller hasSubmorphs ifTrue:
		[scroller submorphs last mouseMove: (evt transformedBy: (scroller transformFrom: self))]! !


!PluggableTextMorph methodsFor: 'initialization' stamp: 'sw 10/10/1999 23:01'!
initialize
	super initialize.
	hasUnacceptedEdits _ false.
	hasEditingConflicts _ false.
	askBeforeDiscardingEdits _ true! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'md 12/12/2003 16:21'!
cancel
	self setText: self getText.
	self setSelection: self getSelection.
	getTextSelector == #annotation ifFalse:
		[(model dependents detect: [:dep | (dep isKindOf: PluggableTextMorph) and: [dep getTextSelector == #annotation]] ifNone: [nil]) ifNotNilDo:
			[:aPane | model changed: #annotation]]! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'md 12/12/2003 16:21'!
toggleAnnotationPaneSize

	| handle origin aHand siblings newHeight lf prevBottom m ht |

	self flag: #bob.		"CRUDE HACK to enable changing the size of the annotations pane"

	owner ifNil: [^self].
	siblings _ owner submorphs.
	siblings size > 3 ifTrue: [^self].
	siblings size < 2 ifTrue: [^self].

	aHand _ self primaryHand.
	origin _ aHand position.
	handle _ HandleMorph new
		forEachPointDo: [:newPoint |
			handle removeAllMorphs.
			newHeight _ (newPoint - origin) y asInteger min: owner height - 50 max: 16.
			lf _ siblings last layoutFrame.
			lf bottomOffset: newHeight.
			prevBottom _ newHeight.
			siblings size - 1 to: 1 by: -1 do: [ :index |
				m _ siblings at: index.
				lf _ m layoutFrame.
				ht _ lf bottomOffset - lf topOffset.
				lf topOffset: prevBottom.
				lf bottomOffset = 0 ifFalse: [
					lf bottomOffset: (prevBottom + ht).
				].
				prevBottom _ prevBottom + ht.
			].
			owner layoutChanged.

		]
		lastPointDo:
			[:newPoint | handle deleteBalloon.
			self halo ifNotNilDo: [:halo | halo addHandles].
		].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor farther from
this point to increase pane.
Click when done.' hand: aHand.
	handle startStepping

! !

!PluggableTextMorph methodsFor: 'model access' stamp: 'ls 7/20/1998 22:50'!
setText: aText
	scrollBar setValue: 0.0.
	textMorph
		ifNil: [textMorph _ TextMorphForEditView new
						contents: aText wrappedTo: self innerBounds width-6.
				textMorph setEditView: self.
				scroller addMorph: textMorph]
		ifNotNil: [textMorph newContents: aText].
	self hasUnacceptedEdits: false.
	self setScrollDeltas.! !


!SelectionMenu methodsFor: 'basic control sequence'!
invokeOn: targetObject
	"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."

	| sel |
	sel _ self startUp.
	sel = nil ifFalse: [^ targetObject perform: sel].
	^ nil

"(SelectionMenu labels:
'sin
cos
neg' lines: #() selections: #(sin cos negated)) invokeOn: 0.7"! !


!SelectionMenu class methodsFor: 'instance creation' stamp: 'bf 9/18/1999 19:55'!
selections: aList
	"Answer an instance of me whose labels and selections are identical.  "

	^ self selections: aList lines: nil! !

!SelectionMenu class methodsFor: 'instance creation' stamp: 'bf 9/18/1999 19:58'!
selections: aList lines: lineList
	"Answer an instance of me whose labels and selections are identical"

	^ self labelList: (aList collect: [:each | each asString])
		lines: lineList
		selections: aList! !


!EmphasizedMenu class methodsFor: 'instance creation' stamp: 'jmv 4/1/2009 15:37'!
selections: selList emphases: emphList
	"Answer an instance of the receiver with the given selections and emphases.  "

	^ (self selections: selList) emphases: emphList

"(EmphasizedMenu selections: #('how' 'well' 'does' 'this' 'work?') emphases: #(bold normal italic struckOut normal)) startUp" ! !


!SelectionMorph methodsFor: 'halo commands' stamp: 'di 9/19/2000 18:25'!
borderColor: aColor

	| bordered |
	bordered _ selectedItems select: [:m | m isKindOf: BorderedMorph].
	undoProperties ifNil: [undoProperties _ bordered collect: [:m | m borderColor]].
	bordered do: [:m | m borderColor: aColor]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'di 9/19/2000 18:25'!
borderWidth: aWidth

	| bordered |
	bordered _ selectedItems select: [:m | m isKindOf: BorderedMorph].
	undoProperties ifNil: [undoProperties _ bordered collect: [:m | m borderWidth]].
	bordered do: [:m | m borderWidth: aWidth]! !

!SelectionMorph methodsFor: 'halo commands' stamp: 'nk 5/6/2003 21:00'!
doDup: evt fromHalo: halo handle: dupHandle.

	selectedItems _ self duplicateMorphCollection: selectedItems.
	selectedItems do: [:m | self owner addMorph: m].
	dupDelta isNil
		ifTrue: ["First duplicate operation -- note starting location"
				dupLoc _ self position.
				evt hand grabMorph: self.
				halo removeAllHandlesBut: dupHandle]
		ifFalse: ["Subsequent duplicate does not grab, but only moves me and my morphs"
				dupLoc _ nil.
				self position: self position + dupDelta]
! !

!SelectionMorph methodsFor: 'initialization' stamp: 'nk 6/13/2002 12:52'!
extendByHand: aHand
	"Assumes selection has just been created and added to some pasteUp or world"
	| startPoint handle |
	startPoint _ self position.
	handle _ NewHandleMorph new followHand: aHand
		forEachPointDo: [:newPoint | | localPt |
			localPt _ (self transformFrom: self world) globalPointToLocal: newPoint.
			self bounds: (startPoint rect: localPt)]
		lastPointDo: [:newPoint | selectedItems isEmpty ifTrue: [self delete]
												ifFalse: [self doneExtending]].
	aHand attachMorph: handle.
	handle startStepping.! !

!SelectionMorph methodsFor: 'private' stamp: 'di 8/31/2000 22:12'!
selectSubmorphsOf: aMorph

	| newItems removals |
	newItems _ aMorph submorphs select:
		[:m | (bounds containsRect: m fullBounds) 
					and: [m~~self
					and: [(m isKindOf: HaloMorph) not]]].
	otherSelection ifNil: [^ selectedItems _ newItems].

	removals _ newItems intersection: itemsAlreadySelected.
	otherSelection setSelectedItems: (itemsAlreadySelected copyWithoutAll: removals).
	selectedItems _ (newItems copyWithoutAll: removals).
! !

!SelectionMorph methodsFor: 'drag and drop' stamp: 'nk 6/27/2002 10:11'!
justDroppedInto: newOwner event: evt

	selectedItems isEmpty ifTrue:
		["Hand just clicked down to draw out a new selection"
		^ self extendByHand: evt hand].
	dupLoc ifNotNil: [dupDelta _ self position - dupLoc].
	selectedItems reverseDo: [:m | 
		WorldState addDeferredUIMessage:
			[m referencePosition: (newOwner localPointToGlobal: m referencePosition).
			newOwner handleDropMorph:
				(DropEvent new setPosition: evt cursorPoint contents: m hand: evt hand)] fixTemps].
	selectedItems _ nil.
	self removeHalo; delete.
	evt wasHandled: true! !


!SequenceableCollection methodsFor: 'accessing'!
at: index ifAbsent: exceptionBlock
	"Answer the element at my position index. If I do not contain an element
	at index, answer the result of evaluating the argument, exceptionBlock."

	(index between: 1 and: self size) ifTrue:
		[^self at: index].
	^exceptionBlock value! !

!SequenceableCollection methodsFor: 'accessing'!
indexOf: anElement 
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer 0."

	^self indexOf: anElement ifAbsent: [0]! !

!SequenceableCollection methodsFor: 'accessing' stamp: 'ls 8/18/1998 00:36'!
indexOf: anElement ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer the result of evaluating the argument, 
	exceptionBlock."
	^self indexOf: anElement startingAt: 1 ifAbsent: exceptionBlock! !

!SequenceableCollection methodsFor: 'accessing'!
indexOf: anElement startingAt: start ifAbsent: exceptionBlock
	"Answer the index of anElement within the receiver. If the receiver does 
	not contain anElement, answer the result of evaluating the argument, 
	exceptionBlock."
	start to: self size do:
		[:i | (self at: i) = anElement ifTrue: [^ i]].
	^ exceptionBlock value! !

!SequenceableCollection methodsFor: 'enumerating'!
collect: aBlock 
	"Refer to the comment in Collection|collect:."
	| result |
	result _ self species new: self size.
	1 to: self size do:
		[:index | result at: index put: (aBlock value: (self at: index))].
	^ result! !

!SequenceableCollection methodsFor: 'enumerating' stamp: 'ar 7/11/1999 08:06'!
keysAndValuesDo: aBlock
	"Enumerate the receiver with all the keys and values"
	1 to: self size do:[:i|
		aBlock value: i value: (self at: i).
	].! !


!ArrayedCollection methodsFor: 'accessing'!
size
	"Primitive. Answer the number of indexable fields in the receiver. This
	value is the same as the largest legal subscript. Primitive is specified
	here to override SequenceableCollection size. Essential. See Object
	documentation whatIsAPrimitive. "

	<primitive: 62>
	^self basicSize! !

!ArrayedCollection methodsFor: 'sorting' stamp: 'ar 4/3/1999 21:31'!
isSortedBy: aBlock
	"Return true if the receiver is sorted by the given criterion."
	| lastEl el |
	self isEmpty ifTrue:[^true].
	lastEl _ self first.
	2 to: self size do: [:i |
		el _ self at: i.
		(aBlock value: lastEl value: el) ifFalse:[^false].
		lastEl _ el].
	^ true
! !

!ArrayedCollection methodsFor: 'sorting'!
mergeFirst: first middle: middle last: last into: dst by: aBlock
	"Private!! Merge the sorted ranges [first..middle] and [middle+1..last] of the receiver into the range [first..last] of dst."

	| i1 i2 val1 val2 out |
	i1 _ first.
	i2 _ middle + 1.
	val1 _ self at: i1.
	val2 _ self at: i2.
	out _ first - 1.  "will be pre-incremented"

	"select 'lower' half of the elements based on comparator"
	[(i1 <= middle) and: [i2 <= last]] whileTrue: [
		(aBlock value: val1 value: val2)
			ifTrue: [
				dst at: (out _ out + 1) put: val1.
				val1 _ self at: (i1 _ i1 + 1)]
			ifFalse: [
				dst at: (out _ out + 1) put: val2.
				i2 _ i2 + 1.
				i2 <= last ifTrue: [val2 _ self at: i2]]].

	"copy the remaining elements"
	i1 <= middle
		ifTrue: [
			dst replaceFrom: out + 1 to: last with: self startingAt: i1]
		ifFalse: [
			dst replaceFrom: out + 1 to: last with: self startingAt: i2].
! !

!ArrayedCollection methodsFor: 'sorting' stamp: 'jm 4/27/98 04:54'!
mergeSortFrom: first to: last src: src dst: dst by: aBlock
	"Private!! Split the range to be sorted in half, sort each half, and merge the two half-ranges into dst."

	| middle |
	first = last ifTrue: [^ self].
	middle _ (first + last) // 2.
	self mergeSortFrom: first to: middle src: dst dst: src by: aBlock.
	self mergeSortFrom: middle + 1 to: last src: dst dst: src by: aBlock.
	src mergeFirst: first middle: middle last: last into: dst by: aBlock.
! !

!ArrayedCollection methodsFor: 'sorting' stamp: 'jm 4/27/98 04:52'!
sort: aBlock
	"Sort this array using the given comparision block. The block should take two arguments and return true if the first element should precede the second in the sorted result."

	self mergeSortFrom: 1 to: self size by: aBlock.
! !


!Array methodsFor: 'converting'!
asArray
	"Answer with the receiver itself."

	^self! !


!ByteArray methodsFor: 'converting' stamp: 'ar 11/2/1998 00:51'!
asByteArray
	^self! !


!Heap methodsFor: 'accessing' stamp: 'ar 9/10/1999 13:02'!
size
	"Return the number of elements in the receiver"
	^tally! !


!Interval methodsFor: 'accessing'!
size

	step < 0
		ifTrue: [start < stop
				ifTrue: [^0]
				ifFalse: [^stop - start // step + 1]]
		ifFalse: [stop < start
				ifTrue: [^0]
				ifFalse: [^stop - start // step + 1]]! !


!OrderedCollection methodsFor: 'accessing'!
size

	^lastIndex - firstIndex + 1! !


!OrderedCollection class methodsFor: 'instance creation'!
new

	^self new: 10! !

!OrderedCollection class methodsFor: 'instance creation'!
new: anInteger 
	"If a subclass adds fields, then it is necessary for that subclass to
	reimplement new:."

	^ super new setCollection: (Array new: anInteger)! !


!RunArray methodsFor: 'adding'!
addLast: value
	"Add value as the last element of the receiver."
	lastIndex _ nil.  "flush access cache"
	(runs size=0 or: [values last ~= value])
	  ifTrue:
		[runs_ runs copyWith: 1.
		values_ values copyWith: value]
	  ifFalse:
		[runs at: runs size put: runs last+1]! !


!Set methodsFor: 'accessing' stamp: 'ar 4/16/1999 07:56'!
capacity
	"Return the current capacity of the receiver"
	^array size! !

!Set methodsFor: 'private'!
findElementOrNil: anObject
	"Answer the index of a first slot containing either a nil (indicating an empty slot) or an element that matches the given object. Answer the index of that slot or zero. Fail if neither a match nor an empty slot is found."
	| index |
	index _ self scanFor: anObject.
	index > 0 ifTrue: [ ^ index ].

	"Bad scene.  Neither have we found a matching element
	nor even an empty slot.  No hashed set is ever supposed to get
	completely full."
	self error: 'There is no free space in this set!!'.! !

!Set methodsFor: 'removing' stamp: 'ar 7/14/1999 11:04'!
copyWithout: oldElement 
	"Answer a copy of the receiver that does not contain any elements equal
	to oldElement."
	^ (self copy)
		 remove: oldElement ifAbsent:[];
		yourself! !


!Dictionary methodsFor: 'accessing' stamp: 'ar 11/2/1998 12:22'!
at: key ifAbsentPut: aBlock 
	"Return the value at the given key.
	If key is not included in the receiver store the result
	of evaluating aBlock as new value."
	^self at: key ifAbsent:[self at: key put: aBlock value]! !

!Dictionary methodsFor: 'removing'!
unreferencedKeys		"TextConstants unreferencedKeys"
	| n |
	^ 'Scanning for references . . .'
		displayProgressAt: Sensor cursorPoint
		from: 0 to: self size
		during:
		[:bar | n _ 0.
		self keys select:
			[:key | bar value: (n _ n+1).
			(Smalltalk allCallsOn: (self associationAt: key)) isEmpty]]! !

!Dictionary methodsFor: 'enumerating' stamp: 'ar 7/11/1999 07:29'!
valuesDo: aBlock 
	"Evaluate aBlock for each of the receiver's keys."

	self associationsDo: [:association | aBlock value: association value]! !

!Dictionary methodsFor: 'private' stamp: 'tk 8/21/97 16:12'!
copy
	"Must copy the associations, or later store will effect both the
original and the copy"

	^ self shallowCopy withArray:
		(array collect: [:assoc |
			assoc ifNil: [nil]
				ifNotNil: [Association key: assoc key
value: assoc value]])! !


!Set class methodsFor: 'initialization'!
rehashAllSets  "Set rehashAllSets"
	| insts |
	self withAllSubclassesDo:
		[:c | insts _ c allInstances.
		insts isEmpty ifFalse:
		['Rehashing instances of ' , c name
			displayProgressAt: Sensor cursorPoint
			from: 1 to: insts size
			during: [:bar |
			1 to: insts size do:
				[:x | bar value: x.
				(insts at: x) rehash]]]]! !


!SimpleButtonMorph methodsFor: 'accessing'!
label

	| s |
	s _ ''.
	self allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s _ m contents]].
	^ s! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'sw 12/7/1999 18:11'!
label: aString

	| oldLabel m |
	(oldLabel _ self findA: StringMorph)
		ifNotNil: [oldLabel delete].
	m _ StringMorph contents: aString font: TextStyle defaultFont.
	self extent: m extent + (borderWidth + 6).
	m position: self center - (m extent // 2).
	self addMorph: m.
	m lock! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'sw 12/10/1999 09:06'!
label: aString font: aFont

	| oldLabel m |
	(oldLabel _ self findA: StringMorph)
		ifNotNil: [oldLabel delete].
	m _ StringMorph contents: aString font: (aFont ifNil: [Preferences standardButtonFont]).
	self extent: (m width + 6) @ (m height + 6).
	m position: self center - (m extent // 2).
	self addMorph: m.
	m lock
! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'sw 6/11/1999 18:40'!
labelString: aString

	| existingLabel |
	(existingLabel _ self findA: StringMorph)
		ifNil:
			[self label: aString]
		ifNotNil:
			[existingLabel contents: aString.
			self fitContents]
! !


!IconicButton methodsFor: 'as yet unclassified' stamp: 'di 2/17/2000 20:30'!
labelGraphic: aForm
	| oldLabel graphicalMorph |
	(oldLabel _ self findA: SketchMorph)
		ifNotNil: [oldLabel delete].
	graphicalMorph _ SketchMorph withForm: aForm.
	self extent: graphicalMorph extent + (borderWidth + 6).
	graphicalMorph position: self center - (graphicalMorph extent // 2).
	self addMorph: graphicalMorph.
	graphicalMorph lock
! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/12/2001 01:38'!
borderInset
	self borderStyle: (BorderStyle inset width: 2).! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/12/2001 01:38'!
borderNormal
	self borderStyle: (BorderStyle width: 2 color: Color transparent).! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/12/2001 01:41'!
borderRaised
	self borderStyle: (BorderStyle raised width: 2).! !

!IconicButton methodsFor: 'initialization' stamp: 'ar 12/17/2001 21:17'!
borderThick
	self borderStyle: (BorderStyle width: 2 color: self raisedColor twiceDarker).! !


!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'ar 10/25/2000 17:50'!
initialize
	super initialize.
	self on: #mouseMove send: #mouseStillDown:onItem: to: self! !


!SketchMorph methodsFor: 'initialization' stamp: 'di 2/17/2000 20:14'!
initialize

	^ self initializeWith: (ScriptingSystem formAtKey: 'Painting') deepCopy.

! !

!SketchMorph methodsFor: 'menu' stamp: 'RAA 11/14/2000 13:44'!
collapse
	
	| priorPosition w collapsedVersion a |

	(w _ self world) ifNil: [^self].
	collapsedVersion _ (self imageForm scaledToSize: 50@50) asMorph.
	collapsedVersion setProperty: #uncollapsedMorph toValue: self.
	collapsedVersion on: #mouseUp send: #uncollapseSketch to: collapsedVersion.
	collapsedVersion setBalloonText: 'A collapsed version of ',self name.
			
	self delete.
	w addMorphFront: (
		a _ AlignmentMorph newRow
			hResizing: #shrinkWrap;
			vResizing: #shrinkWrap;
			borderWidth: 4;
			borderColor: Color white;
			addMorph: collapsedVersion
	).
	collapsedVersion setProperty: #collapsedMorphCarrier toValue: a.

	(priorPosition _ self valueOfProperty: #collapsedPosition ifAbsent: [nil])
	ifNotNil:
		[a position: priorPosition].
! !


!ColorPickerMorph methodsFor: 'accessing' stamp: 'ar 8/25/2001 20:44'!
locationIndicator
	| loc |
	^self valueOfProperty: #locationIndicator ifAbsent:[
		loc _ EllipseMorph new.
		loc color: Color transparent; 
			borderWidth: 1; 
			borderColor: Color red; 
			extent: 6@6.
		self setProperty: #locationIndicator toValue: loc.
		self addMorphFront: loc.
		loc]! !

!ColorPickerMorph methodsFor: 'other' stamp: 'di 11/27/1999 09:12'!
addToWorld: world near: box
	| goodLocation |
	goodLocation _ self bestPositionNear: box inWorld: world.
	world allMorphsDo:
		[:p | (p isMemberOf: ColorPickerMorph) ifTrue:
		[(p ~~ self and: [p owner notNil and: [p target == target]]) ifTrue:
			[(p selector == selector and: [p argument == argument])
				ifTrue: [^ p comeToFront  "uncover existing picker"]
				ifFalse: ["place second picker relative to first"
						goodLocation _ self bestPositionNear: p bounds inWorld: world]]]].
	self position: goodLocation.
	world addMorphFront: self.
	self changed
! !


!Slider methodsFor: 'initialize' stamp: 'dew 1/19/2002 15:19'!
initializeSlider
	slider := RectangleMorph newBounds: self totalSliderArea color: self thumbColor.
	sliderShadow := RectangleMorph newBounds: self totalSliderArea
						color: self pagingArea color.
	slider on: #mouseMove send: #scrollAbsolute: to: self.
	slider on: #mouseDown send: #mouseDownInSlider: to: self.
	slider on: #mouseUp send: #mouseUpInSlider: to: self.
	slider setBorderWidth: 1 borderColor: #raised.
	sliderShadow setBorderWidth: 1 borderColor: #inset.
	"(the shadow must have the pagingArea as its owner to highlight properly)"
	self pagingArea addMorph: sliderShadow.
	sliderShadow hide.
	self addMorph: slider.
	self computeSlider.
! !


!ScrollBar methodsFor: 'geometry' stamp: 'dew 7/22/1999 19:03'!
extent: p
        p x > p y
                ifTrue: [super extent: (p max: 42@8)]
                ifFalse: [super extent: (p max: 8@42)]! !

!ScrollBar methodsFor: 'initialize'!
initialize
	super initialize.
	scrollDelta _ 0.02.
	pageDelta _ 0.2! !

!ScrollBar methodsFor: 'initialize' stamp: 'ar 10/7/2000 15:07'!
initializePagingArea
	pagingArea := RectangleMorph newBounds: self totalSliderArea
								color: (Color r: 0.6 g: 0.6 b: 0.8).
	pagingArea borderWidth: 0.
	pagingArea on: #mouseDown send: #scrollPageInit: to: self.
	pagingArea on: #mouseUp send: #finishedScrolling to: self.
	self addMorph: pagingArea! !

!ScrollBar methodsFor: 'initialize' stamp: 'dgd 3/28/2003 10:24'!
updateDownButtonImage
	"update the receiver's downButton.  put a new image inside"
	downButton removeAllMorphs.
	downButton
		addMorphCentered: (ImageMorph new image: self downImage)! !

!ScrollBar methodsFor: 'initialize' stamp: 'sd 11/8/2003 16:01'!
updateMenuButtonImage
	"update the receiver's menuButton. put a new image inside"
menuButton isNil ifTrue:[^ self].

	menuButton removeAllMorphs.
	menuButton
		addMorphCentered: (ImageMorph new image: self menuImage)! !

!ScrollBar methodsFor: 'initialize' stamp: 'dgd 3/28/2003 19:13'!
updateUpButtonImage
"update the receiver's upButton. put a new image inside"
	upButton removeAllMorphs.
	upButton
		addMorphCentered: (ImageMorph new image: self upImage)! !

!ScrollBar methodsFor: 'scrolling' stamp: 'ar 10/7/2000 15:06'!
finishedScrolling
	self stopStepping.
	self scrollBarAction: nil.
	downButton borderRaised.
	upButton borderRaised.! !


!ScrollBar class methodsFor: 'images' stamp: 'dgd 3/28/2003 10:29'!
createBoxIn: aRectangle 
	"PRIVATE - create an box bounded in aRectangle"
	| box |
	box := RectangleMorph new.
	box extent: (aRectangle scaleBy: 1 / 2) extent rounded;
		 borderWidth: 0.
	""
	^ box! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'sd 11/8/2003 16:02'!
arrowSamples
	"create a set of arrow with different sizes, colors and directions"
	" 
	ScrollBar arrowSamples.  
	"
	| column |
	column := AlignmentMorph newColumn vResizing: #shrinkWrap;
				 hResizing: #shrinkWrap;
				 layoutInset: 1;
				 borderColor: Color black;
				 borderWidth: 0;
				 wrapCentering: #center;
				 cellPositioning: #center;
				 color: Color white;
				 yourself.
	
	self sampleSizes
		do: [:size | 
			| row | 
			row := AlignmentMorph newRow color: Color transparent;
						 vResizing: #shrinkWrap;
						 cellInset: 2 @ 0 yourself.
			
			self sampleColors
				do: [:color | 
					#(#top #right #bottom #left )
						do: [:direction | 
							row addMorphBack: (ScrollBar
									arrowOfDirection: direction
									size: size
									color: color) asMorph]].
			
			column addMorphBack: row].
	
	column openInHand! !


!Socket methodsFor: 'queries' stamp: 'jm 11/4/97 07:15'!
isValid
	"Return true if this socket contains a valid, non-nil socket handle."

	| status |
	socketHandle ifNil: [^ false].
	status _ self primSocketConnectionStatus: socketHandle.
	^ status ~= InvalidSocket
! !


!Socket class methodsFor: 'network initialization' stamp: 'jm 9/15/97 09:30'!
initializeNetwork
	"Initialize the network drivers and the NetNameResolver. Do nothing if the network is already initialized."
	"Note: The network must be re-initialized every time Squeak starts up, so applications that persist across snapshots should be prepared to re-initialize the network as needed. Such applications should call 'Socket initializeNetwork' before every network transaction. "

	NetNameResolver initializeNetwork.
! !


!SoundBuffer class methodsFor: 'objects from disk' stamp: 'tk 10/24/2001 18:34'!
startUpFrom: anImageSegment
	"In this case, do we need to swap word halves when reading this segement?"

	^ (Smalltalk endianness) ~~ (anImageSegment endianness)
			ifTrue: [Message selector: #swapHalves]		"will be run on each instance"
			ifFalse: [nil].! !


!StandardFileMenu class methodsFor: 'instance creation' stamp: 'acg 4/15/1999 00:41'!
oldFileMenu: aDirectory

	^super new oldFileFrom: aDirectory! !


!StarMorph methodsFor: 'initialization' stamp: 'ar 6/25/1999 11:18'!
defaultColor
	"Return the default fill style for the receiver"
	^Color lightBlue! !

!StarMorph methodsFor: 'handles' stamp: 'ar 3/17/2001 14:33'!
addHandles
	| center | 
	self removeHandles.
	center _ vertices sum // vertices size.   "Average vertices to get the center"
	handles _ {center. vertices second} with: {#center. #outside} collect:
		[:p :which | (EllipseMorph newBounds: (Rectangle center: p extent: 8@8)
							color: Color yellow)
				on: #mouseDown send: #dragVertex:event:fromHandle:
						to: self withValue: which;
				on: #mouseMove send: #dragVertex:event:fromHandle:
						to: self withValue: which].
	self addAllMorphs: handles.
	self changed! !


!Stream methodsFor: 'printing' stamp: 'djp 7/21/1998 11:40'!
print: anObject
	anObject printOn: self! !


!ReferenceStream methodsFor: 'writing' stamp: 'tk 7/12/1998 13:30'!
beginInstance: aClass size: anInteger
	"This is for use by storeDataOn: methods.  Cf. Object>>storeDataOn:."
	"Addition of 1 seems to make extra work, since readInstance has to compensate.  Here for historical reasons dating back to Kent Beck's original implementation in late 1988.
	In ReferenceStream, class is just 5 bytes for shared symbol.
	SmartRefStream puts out the names and number of class's instances variables for checking.
6/10/97 16:09 tk: See if we can put on a short header. Type = 16. "

	| short ref |
	short _ true.	"All tests for object header that can be written in 4 bytes"
	anInteger <= 254 ifFalse: [short _ false].	"one byte size"
	ref _ references at: aClass name ifAbsent: [short _ false. nil].
	ref isInteger ifFalse: [short _ false].
	short ifTrue: [short _ (ref < 65536) & (ref > 0) "& (ref ~= self vacantRef)"].  "vacantRef is big"
	short ifTrue: [
		byteStream skip: -1.
		short _ byteStream next = 9.
		byteStream skip: 0].	"ugly workaround"
	short 
		ifTrue: ["passed all the tests!!"
			byteStream skip: -1; nextPut: 16; "type = short header"
				nextPut: anInteger + 1;	"size is short"
				nextNumber: 2 put: ref]
		ifFalse: [
			"default to normal longer object header"
			byteStream nextNumber: 4 put: anInteger + 1.
			self nextPut: aClass name].! !


!StrikeFont class methodsFor: 'instance creation' stamp: 'di 4/2/1999 21:44'!
familyName: aName size: aSize

	^ ((TextStyle named: aName asSymbol) ifNil: [TextStyle default])
		fontOfSize: aSize! !


!String methodsFor: 'accessing'!
lineCount
	"Answer the number of lines represented by the receiver, where every cr adds one line.  5/10/96 sw"

	| cr count |
	cr _ Character cr.
	count _ 1  min: self size..
	1 to: self size do:
		[:i | (self at: i) == cr ifTrue: [count _ count + 1]].
	^ count

"
'Fred
the
Bear' lineCount
"! !

!String methodsFor: 'converting' stamp: 'sw 1/29/2002 11:06'!
asMorph 
	"Answer the receiver as a StringMorph"

	^ StringMorph contents: self

"'bugs black blood' asMorph openInHand"! !


!StringHolder methodsFor: 'initialize-release' stamp: 'sw 10/16/1998 11:36'!
embeddedInMorphicWindowLabeled: labelString
	| window |
	window _ (SystemWindow labelled: labelString) model: self.
	window addMorph: (PluggableTextMorph on: self text: #contents accept: #acceptContents:
			readSelection: nil menu: #codePaneMenu:shifted:)
		frame: (0@0 corner: 1@1).
	^ window! !

!StringHolder methodsFor: 'initialize-release' stamp: 'sw 8/4/1998 18:21'!
openAsMorphLabel: labelString  inWorld: aWorld
	"Workspace new openAsMorphLabel: 'Workspace'"
	| window |
	window _ (SystemWindow labelled: labelString) model: self.

	window addMorph: (PluggableTextMorph on: self text: #contents accept: #acceptContents:
			readSelection: nil menu: #codePaneMenu:shifted:)
		frame: (0@0 corner: 1@1).

	window openInWorld: aWorld! !

!StringHolder methodsFor: 'message list menu' stamp: 'tk 4/18/1998 15:03'!
browseUnusedMethods
	| classes unsent messageList cls |

	(cls _ self selectedClass) ifNil: [^ self].
	classes _ Array with: cls with: cls class.
	unsent _ Set new.
	classes do: [:c | unsent addAll: c selectors].
	unsent _ Smalltalk allUnSentMessagesIn: unsent.
	messageList _ OrderedCollection new.
	classes do: [:c | (c selectors select: [:s | unsent includes: s]) asSortedCollection
					do: [:sel | messageList add: c name , ' ' , sel]].
	Smalltalk browseMessageList: messageList name: 'Unsent Methods in ', cls name! !

!StringHolder methodsFor: 'message list menu' stamp: 'tk 4/18/1998 16:06'!
classHierarchy
	"Create and schedule a class list browser on the receiver's hierarchy."

	Utilities spawnHierarchyForClass: self selectedClassOrMetaClass "OK if nil"
		selector: self selectedMessageName
! !

!StringHolder methodsFor: 'message list menu' stamp: 'sw 5/22/2001 16:17'!
offerDurableMenuFrom: menuRetriever shifted: aBoolean
	"Pop up (morphic only) a menu whose target is the receiver and whose contents are provided by sending the menuRetriever to the receiver.  The menuRetriever takes two arguments: a menu, and a boolean representing the shift state; put a stay-up item at the top of the menu."

	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	self perform: menuRetriever with: aMenu with: aBoolean.
		aMenu popUpInWorld! !

!StringHolder methodsFor: 'message list menu' stamp: 'RAA 5/29/2001 10:45'!
openSingleMessageBrowser
	| msgName mr |
	"Create and schedule a message list browser populated only by the currently selected message"

	(msgName _ self selectedMessageName) ifNil: [^ self].

	mr _ MethodReference new
		setStandardClass: self selectedClassOrMetaClass
		methodSymbol: msgName.

	Smalltalk 
		browseMessageList: (Array with: mr)
		name: mr asStringOrText
		autoSelect: nil! !


!CodeHolder methodsFor: 'annotation' stamp: 'nk 4/28/2004 10:16'!
addOptionalAnnotationsTo: window at: fractions plus: verticalOffset
	"Add an annotation pane to the window if preferences indicate a desire for it, and return the incoming verticalOffset plus the height of the added pane, if any"

	| aTextMorph divider delta |
	self wantsAnnotationPane ifFalse: [^ verticalOffset].
	aTextMorph _ PluggableTextMorph 
		on: self
		text: #annotation 
		accept: nil
		readSelection: nil
		menu: #annotationPaneMenu:shifted:.
	aTextMorph
		askBeforeDiscardingEdits: false;
		borderWidth: 0;
		hideScrollBarsIndefinitely.
	divider _ BorderedSubpaneDividerMorph forBottomEdge.
	Preferences alternativeWindowLook ifTrue:[
		divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2.
	].
	delta _ self defaultAnnotationPaneHeight.
	window 
		addMorph: aTextMorph 
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@verticalOffset corner: 0@(verticalOffset + delta - 1))).
	window 
		addMorph: divider
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@(verticalOffset + delta - 1) corner: 0@(verticalOffset + delta))).
	^ verticalOffset + delta! !

!CodeHolder methodsFor: 'construction' stamp: 'nk 11/9/2003 08:06'!
buildMorphicCodePaneWith: editString
	"Construct the pane that shows the code.
	Respect the Preference for standardCodeFont."

	| codePane |
	codePane := PluggableTextMorph
				on: self
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:.
	codePane font: Preferences standardCodeFont.
	editString
		ifNotNil: [codePane editString: editString.
			codePane hasUnacceptedEdits: true].
	^ codePane! !

!CodeHolder methodsFor: 'controls' stamp: 'ar 8/19/2001 16:15'!
addOptionalButtonsTo: window at: fractions plus: verticalOffset
	"If the receiver wishes it, add a button pane to the window, and answer the verticalOffset plus the height added"

	| delta buttons divider |
	self wantsOptionalButtons ifFalse: [^verticalOffset].
	delta _ self defaultButtonPaneHeight.
	buttons _ self optionalButtonRow 
		color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]);
		borderWidth: 0.
	Preferences alternativeWindowLook ifTrue:[
		buttons color: Color transparent.
		buttons submorphsDo:[:m| m borderWidth: 2; borderColor: #raised].
	].
	divider _ BorderedSubpaneDividerMorph forBottomEdge.
	Preferences alternativeWindowLook ifTrue:[
		divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2.
	].
	window 
		addMorph: buttons
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@verticalOffset corner: 0@(verticalOffset + delta - 1))).
	window 
		addMorph: divider
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@(verticalOffset + delta - 1) corner: 0@(verticalOffset + delta))).
	^ verticalOffset + delta! !

!CodeHolder methodsFor: 'controls' stamp: 'gm 2/16/2003 20:37'!
buttonWithSelector: aSelector 
	"If receiver has a control button with the given action selector answer it, else answer nil.  morphic only at this point"

	| aWindow aPane |
	((aWindow := self containingWindow) isSystemWindow) 
		ifFalse: [^nil].
	(aPane := aWindow submorphNamed: 'buttonPane') ifNil: [^nil].
	^aPane submorphThat: 
			[:m | 
			(m isKindOf: PluggableButtonMorph) and: [m actionSelector == aSelector]]
		ifNone: [^nil]! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 09:09'!
diffButton
	"Return a checkbox that lets the user decide whether diffs should be shown or not.  Not sent any more but retained against the possibility of existing subclasses outside the base image using it."

	|  outerButton aButton |
	outerButton _ AlignmentMorph newRow.
	outerButton wrapCentering: #center; cellPositioning: #leftCenter.
	outerButton color:  Color transparent.
	outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox).
	aButton
		target: self;
		actionSelector: #toggleRegularDiffing;
		getSelector: #showingRegularDiffs.
	outerButton addMorphBack: (StringMorph contents: 'diffs') lock.
	outerButton setBalloonText: 'If checked, then code differences from the previous version, if any, will be shown.'.

	^ outerButton
! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 6/8/2001 00:37'!
prettyDiffButton
	"Return a checkbox that lets the user decide whether prettyDiffs should be shown or not"

	|  outerButton aButton |
	outerButton _ AlignmentMorph newRow.
	outerButton wrapCentering: #center; cellPositioning: #leftCenter.
	outerButton color:  Color transparent.
	outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox).
	aButton
		target: self;
		actionSelector: #togglePrettyDiffing;
		getSelector: #showingPrettyDiffs.
	outerButton addMorphBack: (StringMorph contents: 'prettyDiffs') lock.
	(self isKindOf: VersionsBrowser)
		ifTrue:
			[outerButton setBalloonText: 'If checked, then pretty-printed code differences from the previous version, if any, will be shown.']
		ifFalse:
			[outerButton setBalloonText: 'If checked, then pretty-printed code differences between the file-based method and the in-memory version, if any, will be shown.'].

	^ outerButton
! !

!CodeHolder methodsFor: 'diffs' stamp: 'sw 11/13/2001 07:37'!
regularDiffButton
	"Return a checkbox that lets the user decide whether regular diffs should be shown or not"

	|  outerButton aButton |
	outerButton _ AlignmentMorph newRow.
	outerButton wrapCentering: #center; cellPositioning: #leftCenter.
	outerButton color:  Color transparent.
	outerButton hResizing: #shrinkWrap; vResizing: #shrinkWrap.
	outerButton addMorph: (aButton _ UpdatingThreePhaseButtonMorph checkBox).
	aButton
		target: self;
		actionSelector: #toggleRegularDiffing;
		getSelector: #showingRegularDiffs.
	outerButton addMorphBack: (StringMorph contents: 'diffs') lock.
	outerButton setBalloonText: 'If checked, then code differences from the previous version, if any, will be shown.'.

	^ outerButton
! !

!CodeHolder methodsFor: 'misc' stamp: 'JW 2/3/2001 09:38'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row innerFractions |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: Color black;
		layoutPolicy: ProportionalLayout new.

	verticalOffset _ 0.
	innerFractions _ 0@0 corner: 1@0.
	verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset _ self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.

	row 
		addMorph: ((self buildMorphicCodePaneWith: editString) borderWidth: 0)
		fullFrame: (
			LayoutFrame 
				fractions: (innerFractions withBottom: 1) 
				offsets: (0@verticalOffset corner: 0@0)
		).
	window 
		addMorph: row
		frame: nominalFractions.

	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.! !

!CodeHolder methodsFor: 'misc' stamp: 'sw 8/1/2001 11:08'!
menuButton
	"Answer a button that brings up a menu.  Useful when adding new features, but at present is between uses"

	| aButton |
	aButton _ IconicButton new target: self;
		borderWidth: 0;
		labelGraphic: (ScriptingSystem formAtKey: #TinyMenu);
		color: Color transparent; 
		actWhen: #buttonDown;
		actionSelector: #offerMenu;
		yourself.
	aButton setBalloonText: 'click here to get a menu with further options'.
	^ aButton
! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/18/2001 23:35'!
addContentsTogglesTo: aMenu
	"Add updating menu toggles governing contents to aMenu."

	self contentsSymbolQuints do:
		[:aQuint |
			aQuint == #-
				ifTrue:
					[aMenu addLine]
				ifFalse:
					[aMenu addUpdating: aQuint third target: self action: aQuint second.
					aMenu balloonTextForLastItem: aQuint fifth]]! !

!CodeHolder methodsFor: 'what to show' stamp: 'sw 5/24/2001 14:14'!
offerWhatToShowMenu
	"Offer a menu governing what to show"

	 | aMenu  |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu addTitle: 'What to show'.
	aMenu addStayUpItem.
	self addContentsTogglesTo: aMenu.
	aMenu popUpInWorld 
! !

!CodeHolder methodsFor: 'categories & search pane' stamp: 'sw 3/7/2001 12:17'!
listPaneWithSelector: aSelector
	"If, among my window's paneMorphs, there is a list pane defined with aSelector as its retriever, answer it, else answer nil"

	| aWindow |
	^ (aWindow _ self containingWindow) ifNotNil:
		[aWindow paneMorphSatisfying:
			[:aMorph | (aMorph isKindOf: PluggableListMorph) and:
				[aMorph getListSelector == aSelector]]]! !

!CodeHolder methodsFor: 'categories & search pane' stamp: 'sw 12/1/2000 20:44'!
newSearchPane
	"Answer a new search pane for the receiver"

	| aTextMorph |
	aTextMorph _ PluggableTextMorph on: self
					text: #lastSearchString accept: #lastSearchString:
					readSelection: nil menu: nil.
	aTextMorph setProperty: #alwaysAccept toValue: true.
	aTextMorph askBeforeDiscardingEdits: false.
	aTextMorph acceptOnCR: true.
	aTextMorph setBalloonText: 'Type here and hit ENTER, and all methods whose selectors match what you typed will appear in the list pane below.'.
	^ aTextMorph! !

!CodeHolder methodsFor: 'categories & search pane' stamp: 'sw 3/7/2001 12:21'!
textPaneWithSelector: aSelector
	"If, among my window's paneMorphs, there is a text pane defined with aSelector as its retriever, answer it, else answer nil"

	| aWindow |
	^ (aWindow _ self containingWindow) ifNotNil:
		[aWindow paneMorphSatisfying:
			[:aMorph | (aMorph isKindOf: PluggableTextMorph) and:
				[aMorph getTextSelector == aSelector]]]! !


!Browser methodsFor: 'accessing' stamp: 'tk 4/2/98 13:33'!
contentsSelection
	"Return the interval of text in the code pane to select when I set the pane's contents"

	messageCategoryListIndex > 0 & (messageListIndex = 0) 
		ifTrue: [^ 1 to: 500]	"entire empty method template"
		ifFalse: [^ 1 to: 0]  "null selection"! !

!Browser methodsFor: 'class comment pane' stamp: 'nk 2/15/2004 13:20'!
buildMorphicCommentPane
	"Construct the pane that shows the class comment.
	Respect the Preference for standardCodeFont."

	| commentPane |
	commentPane := BrowserCommentTextMorph
				on: self
				text: #classCommentText
				accept: #classComment:notifying:
				readSelection: nil
				menu: #codePaneMenu:shifted:.
	commentPane font: Preferences standardCodeFont.
	^ commentPane! !

!Browser methodsFor: 'class functions' stamp: 'RAA 5/28/2001 13:38'!
renameClass
	| oldName newName obs |
	classListIndex = 0 ifTrue: [^ self].
	self okToChange ifFalse: [^ self].
	oldName _ self selectedClass name.
	newName _ self request: 'Please type new class name' initialAnswer: oldName.
	newName = '' ifTrue: [^ self].  " Cancel returns '' "
	newName _ newName asSymbol.
	newName = oldName ifTrue: [^ self].
	(Smalltalk includesKey: newName)
		ifTrue: [^ self error: newName , ' already exists'].
	self selectedClass rename: newName.
	self changed: #classList.
	self classListIndex: ((systemOrganizer listAtCategoryNamed: self selectedSystemCategoryName) indexOf: newName).
	obs _ Smalltalk allCallsOn: (Smalltalk associationAt: newName).
	obs isEmpty ifFalse: [
		Smalltalk 
			browseMessageList: obs
			name: 'Obsolete References to ' , oldName
			autoSelect: oldName
	].
! !

!Browser methodsFor: 'drag and drop' stamp: 'sr 4/25/2000 07:12'!
codeTextMorph
	^ self dependents
		detect: [:dep | (dep isKindOf: PluggableTextMorph)
				and: [dep getTextSelector == #contents]]
		ifNone: []! !

!Browser methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:18'!
dragTransferTypeForMorph: dragSource 
	^(dragSource isKindOf: PluggableListMorph)
		ifTrue: [dragSource getListSelector]! !

!Browser methodsFor: 'initialize-release' stamp: 'ar 1/31/2001 20:55'!
openAsMorphEditing: editString
	"Create a pluggable version of all the morphs for a Browser in Morphic"
	| window hSepFrac |

	hSepFrac _ 0.4.
	window _ (SystemWindow labelled: 'later') model: self.

	window 
		addMorph: self buildMorphicSystemCatList
		frame: (0@0 corner: 0.25@hSepFrac).
	self 
		addClassAndSwitchesTo: window 
		at: (0.25@0 corner: 0.5@hSepFrac)
		plus: 0.
	window 
		addMorph: self buildMorphicMessageCatList
		frame: (0.5@0 extent: 0.25@hSepFrac).
	window addMorph: self buildMorphicMessageList
		frame: (0.75@0 extent: 0.25@hSepFrac).
	self 
		addLowerPanesTo: window 
		at: (0@hSepFrac corner: 1@1) 
		with: editString.
	window setUpdatablePanesFrom: #(systemCategoryList classList messageCategoryList messageList).
	^ window! !

!Browser methodsFor: 'metaclass'!
metaClassIndicated
	"Answer the boolean flag that indicates which of the method dictionaries, 
	class or metaclass."

	^metaClassIndicated! !

!Browser methodsFor: 'construction' stamp: 'nk 2/15/2004 13:49'!
addLowerPanesTo: window at: nominalFractions with: editString
	| commentPane |
	super addLowerPanesTo: window at: nominalFractions with: editString.
	commentPane _ self buildMorphicCommentPane.
	window addMorph: commentPane fullFrame: (LayoutFrame fractions: (0@0.75 corner: 1@1)).
	self changed: #editSelection.! !


!Browser class methodsFor: 'class initialization'!
initialize
        "Browser initialize"

        RecentClasses := OrderedCollection new! !


!ChangeList methodsFor: 'initialization-release' stamp: 'tpr 10/4/2001 21:58'!
openAsMorphName: labelString multiSelect: multiSelect 
	"Open a morphic view for the messageSet, whose label is labelString. 
	The listView may be either single or multiple selection type"
	| window listHeight listPane |
	listHeight _ 0.4.
	window _ (SystemWindow labelled: labelString)
				model: self.
	listPane _ multiSelect
				ifTrue: [PluggableListMorphOfMany
						on: self
						list: #list
						primarySelection: #listIndex
						changePrimarySelection: #toggleListIndex:
						listSelection: #listSelectionAt:
						changeListSelection: #listSelectionAt:put:
						menu: (self showsVersions
								ifTrue: [#versionsMenu:]
								ifFalse: [#changeListMenu:])]
				ifFalse: [PluggableListMorph
						on: self
						list: #list
						selected: #listIndex
						changeSelected: #toggleListIndex:
						menu: (self showsVersions
								ifTrue: [#versionsMenu:]
								ifFalse: [#changeListMenu:])].
	listPane keystrokeActionSelector: #changeListKey:from:.
	window
		addMorph: listPane
		frame: (0 @ 0 extent: 1 @ listHeight).
	self
		addLowerPanesTo: window
		at: (0 @ listHeight corner: 1 @ 1)
		with: nil.
	^ window openInWorld! !

!ChangeList methodsFor: 'menu actions' stamp: 'RAA 1/11/2001 08:42'!
buildMorphicCodePaneWith: editString

	| codePane |

	codePane _ AcceptableCleanTextMorph
		on: self
		text: #contents 
		accept: #contents:
		readSelection: #contentsSelection 
		menu: #codePaneMenu:shifted:.
	editString ifNotNil: [
		codePane editString: editString.
		codePane hasUnacceptedEdits: true
	].
	^codePane
! !


!ChangeSorter methodsFor: 'creation' stamp: 'sd 5/23/2003 14:25'!
morphicWindow
	"ChangeSorter new openAsMorph"
	|  window |

	myChangeSet ifNil: [self myChangeSet: ChangeSet current]. 
	window _ (SystemWindow labelled: self labelString) model: self.
	self openAsMorphIn: window rect: (0@0 extent: 1@1).
	^ window
! !

!ChangeSorter methodsFor: 'creation' stamp: 'sw 2/26/2001 12:00'!
openAsMorphIn: window rect: rect
	"Add a set of change sorter views to the given top view offset by the given amount. To create a single change sorter, call this once with an offset of 0@0. To create a dual change sorter, call it twice with offsets of 0@0 and 0.5@0."

	| csListHeight msgListHeight csMsgListHeight |
	contents _ ''.
	csListHeight _ 0.25.
	msgListHeight _ 0.25.
	csMsgListHeight _ csListHeight + msgListHeight.
	self addDependent: window.		"so it will get changed: #relabel"

	window addMorph: ((PluggableListMorphByItem on: self
				list: #changeSetList
				selected: #currentCngSet
				changeSelected: #showChangeSetNamed:
				menu: #changeSetMenu:shifted:
				keystroke: #changeSetListKey:from:)
			autoDeselect: false)
		frame: (((0@0 extent: 0.5@csListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	window addMorph: (PluggableListMorphByItem on: self
				list: #classList
				selected: #currentClassName
				changeSelected: #currentClassName:
				menu: #classListMenu:shifted:
				keystroke: #classListKey:from:)
		frame: (((0.5@0 extent: 0.5@csListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	window addMorph: (PluggableListMorphByItem on: self
				list: #messageList
				selected: #currentSelector
				changeSelected: #currentSelector:
				menu: #messageMenu:shifted:
				keystroke: #messageListKey:from:)
		frame: (((0@csListHeight extent: 1@msgListHeight)
			scaleBy: rect extent) translateBy: rect origin).

	 self addLowerPanesTo: window
		at: (((0@csMsgListHeight corner: 1@1) scaleBy: rect extent) translateBy: rect origin)
		with: nil.! !

!ChangeSorter methodsFor: 'access' stamp: 'di 6/15/1998 20:33'!
modelWakeUp
	"A window with me as model is being entered.  Make sure I am up-to-date with the changeSets."

	self canDiscardEdits ifTrue: [self update]! !


!ChangeSetBrowser methodsFor: 'initialization' stamp: 'sw 3/29/2001 23:38'!
openAsMorphIn: window rect: rect
	"Add a set of changeSetBrowser views to the given top view offset by the given amount"

	| aHeight |
	contents _ ''.
	aHeight _ 0.25.
	self addDependent: window.		"so it will get changed: #relabel"


	window addMorph: (PluggableListMorphByItem on: self
				list: #classList
				selected: #currentClassName
				changeSelected: #currentClassName:
				menu: #classListMenu:shifted:
				keystroke: #classListKey:from:)
		frame: (((0.0@0 extent: 0.5 @ aHeight)
			scaleBy: rect extent) translateBy: rect origin).

	window addMorph: (PluggableListMorphByItem on: self
				list: #messageList
				selected: #currentSelector
				changeSelected: #currentSelector:
				menu: #messageMenu:shifted:
				keystroke: #messageListKey:from:)
		frame: (((0.5@0 extent: 0.5 @ aHeight)
			scaleBy: rect extent) translateBy: rect origin).

	 self addLowerPanesTo: window
		at: (((0@aHeight corner: 1@1) scaleBy: rect extent) translateBy: rect origin)
		with: nil! !


!ClassCommentVersionsBrowser methodsFor: 'menu' stamp: 'asm 8/13/2002 23:37'!
openSingleMessageBrowser
	| mr |
	"Create and schedule a message list browser populated only by the currently selected message"

	mr _ MethodReference new
				setStandardClass: self selectedClass
				methodSymbol: #Comment.

	Smalltalk 
		browseMessageList: (Array with: mr)
		name: mr asStringOrText
		autoSelect: nil! !


!ClassListBrowser class methodsFor: 'examples' stamp: 'sw 7/27/2002 14:34'!
example2
	"Put up a ClassListBrowser that shows all classes whose names start with the letter S"

	self new initForClassesNamed: (Smalltalk allClasses collect: [:c | c name] thenSelect: [:aName | aName first == $S]) title: 'All classes starting with S'

"ClassListBrowser example2"
	! !


!Debugger methodsFor: 'initialize' stamp: 'nk 2/12/2003 22:56'!
buttonRowForPreDebugWindow: aDebugWindow
	| aRow aButton quads |
	aRow _ AlignmentMorph newRow hResizing: #spaceFill.
	aRow beSticky.
	aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer.
	quads _ OrderedCollection withAll: self preDebugButtonQuads.
	(self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
		quads add: { 'Create'. #createMethod. #magenta. 'create the missing method' }
	].
	quads do:
			[:quad |
				aButton _ SimpleButtonMorph new target: aDebugWindow.
				aButton color: Color transparent; borderWidth: 1.
				aButton actionSelector: quad second.
				aButton label: quad first.
				aButton submorphs first color: (Color colorFrom: quad third).
				aButton setBalloonText: quad fourth.
				Preferences alternativeWindowLook 
					ifTrue:[aButton borderWidth: 2; borderColor: #raised].
				aRow addMorphBack: aButton.
				aRow addMorphBack: AlignmentMorph newVariableTransparentSpacer].
	^ aRow! !

!Debugger methodsFor: 'initialize' stamp: 'tk 5/9/2003 11:07'!
openFullMorphicLabel: aLabelString
	"Open a full morphic debugger with the given label"

	| window aListMorph oldContextStackIndex |
	oldContextStackIndex _ contextStackIndex.
	self expandStack. "Sets contextStackIndex to zero."

	window _ (SystemWindow labelled: aLabelString) model: self.
	aListMorph _ PluggableListMorph on: self list: #contextStackList
			selected: #contextStackIndex changeSelected: #toggleContextStackIndex:
			menu: #contextStackMenu:shifted: keystroke: #contextStackKey:from:.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	window addMorph: aListMorph
		frame: (0@0 corner: 1@0.25).

	self addLowerPanesTo: window at: (0@0.25 corner: 1@0.8) with: nil.

	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: self receiverInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		frame: (0@0.8 corner: 0.2@1).
	window addMorph: (PluggableTextMorph on: self receiverInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0.2@0.8 corner: 0.5@1).
	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: self contextVariablesInspector list: #fieldList
			selected: #selectionIndex changeSelected: #toggleIndex:
			menu: #fieldListMenu: keystroke: #inspectorKey:from:)
		frame: (0.5@0.8 corner: 0.7@1).
	window addMorph: (PluggableTextMorph on: self contextVariablesInspector
			text: #contents accept: #accept:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (0.7@0.8 corner: 1@1).
	window openInWorld.
	self toggleContextStackIndex: oldContextStackIndex.
	^ window ! !

!Debugger methodsFor: 'initialize' stamp: 'sw 8/14/2000 13:20'!
preDebugButtonQuads

	^ #(('Proceed'		proceed 	blue 	'continue execution' )
		('Abandon'		abandon 	black 	'abandon this execution by closing this window')
		('Debug'		debug 		red 		'bring up a debugger'))! !

!Debugger methodsFor: 'controls' stamp: 'sw 9/3/2002 10:24'!
addOptionalButtonsTo: window at: fractions plus: verticalOffset
	"Add button panes to the window.  A row of custom debugger-specific buttons (Proceed, Restart, etc.) is always added, and if optionalButtons is in force, then the standard code-tool buttons are also added.  Answer the verticalOffset plus the height added."

	| delta buttons divider anOffset |
	anOffset _ (Preferences optionalButtons and: [Preferences extraDebuggerButtons])
		ifTrue:
			[super addOptionalButtonsTo: window at: fractions plus: verticalOffset]
		ifFalse:
			[verticalOffset].

	delta _ self defaultButtonPaneHeight.
	buttons _ self customButtonRow.
	buttons	 color: (Display depth <= 8 ifTrue: [Color transparent] ifFalse: [Color gray alpha: 0.2]);
		borderWidth: 0.
	Preferences alternativeWindowLook ifTrue:
		[buttons color: Color transparent.
		buttons submorphsDo:[:m | m borderWidth: 2; borderColor: #raised]].
	divider _ BorderedSubpaneDividerMorph forBottomEdge.
	Preferences alternativeWindowLook ifTrue:
		[divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2].
	window 
		addMorph: buttons
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@anOffset corner: 0@(anOffset + delta - 1))).
	window 
		addMorph: divider
		fullFrame: (LayoutFrame 
				fractions: fractions 
				offsets: (0@(anOffset + delta - 1) corner: 0@(anOffset + delta))).
	^ anOffset + delta! !


!FileContentsBrowser methodsFor: 'creation' stamp: 'nk 4/28/2004 10:18'!
addLowerPanesTo: window at: nominalFractions with: editString

	| verticalOffset row codePane infoPane infoHeight divider |

	row _ AlignmentMorph newColumn
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		layoutInset: 0;
		borderWidth: 1;
		borderColor: Color black;
		layoutPolicy: ProportionalLayout new.

	codePane _ PluggableTextMorph on: self text: #contents accept: #contents:notifying:
			readSelection: #contentsSelection menu: #codePaneMenu:shifted:.
	infoPane _ PluggableTextMorph on: self text: #infoViewContents accept: nil
			readSelection: nil menu: nil.
	infoPane askBeforeDiscardingEdits: false.
	verticalOffset _ 0.

">>not with this browser--- at least not yet ---
	innerFractions _ 0@0 corner: 1@0.
	verticalOffset _ self addOptionalAnnotationsTo: row at: innerFractions plus: verticalOffset.
	verticalOffset _ self addOptionalButtonsTo: row  at: innerFractions plus: verticalOffset.
<<<<"

	infoHeight _ 20.
	row 
		addMorph: (codePane borderWidth: 0)
		fullFrame: (
			LayoutFrame 
				fractions: (0@0 corner: 1@1) 
				offsets: (0@verticalOffset corner: 0@infoHeight negated)
		).
	divider _ BorderedSubpaneDividerMorph forTopEdge.
	Preferences alternativeWindowLook ifTrue:[
		divider extent: 4@4; color: Color transparent; borderColor: #raised; borderWidth: 2.
	].
	row 
		addMorph: divider
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@infoHeight negated corner: 0@(1-infoHeight))
		).
	row 
		addMorph: (infoPane borderWidth: 0; hideScrollBarsIndefinitely)
		fullFrame: (
			LayoutFrame 
				fractions: (0@1 corner: 1@1) 
				offsets: (0@(1-infoHeight) corner: 0@0)
		).
	window 
		addMorph: row
		frame: nominalFractions.

	row on: #mouseEnter send: #paneTransition: to: window.
	row on: #mouseLeave send: #paneTransition: to: window.

! !

!FileContentsBrowser methodsFor: 'creation' stamp: 'nk 4/28/2004 10:18'!
openAsMorph
	"Create a pluggable version of all the views for a Browser, including views and controllers."
	| window aListExtent next mySingletonList |
	window _ (SystemWindow labelled: 'later') model: self.
	self packages size = 1
		ifTrue: [
			aListExtent _ 0.333333 @ 0.34.
			self systemCategoryListIndex: 1.
			mySingletonList _ PluggableListMorph on: self list: #systemCategorySingleton
					selected: #indexIsOne changeSelected: #indexIsOne:
					menu: #packageListMenu:
					keystroke: #packageListKey:from:.
			mySingletonList hideScrollBarsIndefinitely.
			window addMorph: mySingletonList frame: (0@0 extent: 1.0@0.06).
			next := 0@0.06]
		ifFalse: [
			aListExtent _ 0.25 @ 0.4.
			window addMorph: (PluggableListMorph on: self list: #systemCategoryList
					selected: #systemCategoryListIndex changeSelected: #systemCategoryListIndex:
					menu: #packageListMenu:
					keystroke: #packageListKey:from:)
				frame: (0@0 extent: aListExtent).
			next := aListExtent x @ 0].

	self addClassAndSwitchesTo: window at: (next extent: aListExtent) plus: 0.

	next := next + (aListExtent x @ 0).
	window addMorph: (PluggableListMorph on: self list: #messageCategoryList
			selected: #messageCategoryListIndex changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu:)
		frame: (next extent: aListExtent).
	next := next + (aListExtent x @ 0).
	window addMorph: (PluggableListMorph on: self list: #messageList
			selected: #messageListIndex changeSelected: #messageListIndex:
			menu: #messageListMenu:
			keystroke: #messageListKey:from:)
		frame: (next extent: aListExtent).

	self addLowerPanesTo: window at: (0@0.4 corner: 1@1) with: nil.
	^ window
! !


!FileList methodsFor: 'file list menu' stamp: 'tk 3/15/2000 10:32'!
compressFile
	"Compress the currently selected file"

	(directory readOnlyFileNamed: self fullName) compressFile.
	self updateFileList! !

!FileList methodsFor: 'initialization' stamp: 'sw 11/30/2002 14:36'!
optionalButtonRow
	"Answer the button row associated with a file list"

	| aRow |
	aRow _ AlignmentMorph newRow beSticky.
	aRow color: Color transparent.
	aRow clipSubmorphs: true.
	aRow layoutInset: 5@1; cellInset: 6.
	self universalButtonServices do:  "just the three sort-by items"
			[:service |
				aRow addMorphBack: (service buttonToTriggerIn: self).
				(service selector  == #sortBySize)
					ifTrue:
						[aRow addTransparentSpacerOfSize: (4@0)]].
	aRow setNameTo: 'buttons'.
	aRow setProperty: #buttonRow toValue: true.  "Used for dynamic retrieval later on"
	^ aRow! !


!FileList class methodsFor: 'instance creation' stamp: 'nk 6/15/2003 13:04'!
addButtonsAndFileListPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
	| fileListMorph row buttonHeight fileListTop divider dividerDelta buttons |
	fileListMorph _ PluggableListMorph
				on: aFileList
				list: #fileList
				selected: #fileListIndex
				changeSelected: #fileListIndex:
				menu: #fileListMenu:.
	fileListMorph enableDrag: true; enableDrop: false.
	aFileList wantsOptionalButtons
		ifTrue: [buttons _ aFileList optionalButtonRow.
			divider _ BorderedSubpaneDividerMorph forBottomEdge.
			dividerDelta _ 0.
			Preferences alternativeWindowLook
				ifTrue: [buttons color: Color transparent.
					buttons
						submorphsDo: [:m | m borderWidth: 2;
								 borderColor: #raised].
divider extent: 4 @ 4;
						 color: Color transparent;
						 borderColor: #raised;
						 borderWidth: 2.
					fileListMorph borderColor: Color transparent.
					dividerDelta _ 3].
			row _ AlignmentMorph newColumn hResizing: #spaceFill;
						 vResizing: #spaceFill;
						 layoutInset: 0;
						 borderWidth: 2;
						 layoutPolicy: ProportionalLayout new.
			buttonHeight _ self defaultButtonPaneHeight.
			row
				addMorph: buttons
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 0)
						offsets: (0 @ 0 corner: 0 @ buttonHeight)).
			row
				addMorph: divider
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 0)
						offsets: (0 @ buttonHeight corner: 0 @ buttonHeight + dividerDelta)).
			row
				addMorph: fileListMorph
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 1)
						offsets: (0 @ buttonHeight + dividerDelta corner: 0 @ 0)).
			window
				addMorph: row
				fullFrame: (LayoutFrame
						fractions: upperFraction
						offsets: (0 @ offset corner: 0 @ 0)).
			Preferences alternativeWindowLook
				ifTrue: [row borderWidth: 2]
				ifFalse: [row borderWidth: 0]]
		ifFalse: [fileListTop _ 0.
			window
				addMorph: fileListMorph
				frame: (0.3 @ fileListTop corner: 1 @ 0.3)].! !

!FileList class methodsFor: 'instance creation' stamp: 'nk 4/28/2004 10:18'!
addVolumesAndPatternPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
	| row patternHeight volumeListMorph patternMorph divider dividerDelta |
	row _ AlignmentMorph newColumn hResizing: #spaceFill;
				 vResizing: #spaceFill;
				 layoutInset: 0;
				 borderWidth: 0;
				 layoutPolicy: ProportionalLayout new.
	patternHeight _ 25.
	volumeListMorph _ (PluggableListMorph
				on: aFileList
				list: #volumeList
				selected: #volumeListIndex
				changeSelected: #volumeListIndex:
				menu: #volumeMenu:)
				autoDeselect: false.
	volumeListMorph enableDrag: false; enableDrop: true.
	patternMorph _ PluggableTextMorph
				on: aFileList
				text: #pattern
				accept: #pattern:.
	patternMorph acceptOnCR: true.
	patternMorph hideScrollBarsIndefinitely.
	divider _ BorderedSubpaneDividerMorph horizontal.
	dividerDelta _ 0.
	Preferences alternativeWindowLook
		ifTrue: [divider extent: 4 @ 4;
				 color: Color transparent;
				 borderColor: #raised;
				 borderWidth: 2.
			volumeListMorph borderColor: Color transparent.
			patternMorph borderColor: Color transparent.
			dividerDelta _ 3].
	row
		addMorph: (volumeListMorph autoDeselect: false)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ patternHeight negated - dividerDelta)).
	row
		addMorph: divider
		fullFrame: (LayoutFrame
				fractions: (0 @ 1 corner: 1 @ 1)
				offsets: (0 @ patternHeight negated - dividerDelta corner: 0 @ patternHeight negated)).
	row
		addMorph: patternMorph
		fullFrame: (LayoutFrame
				fractions: (0 @ 1 corner: 1 @ 1)
				offsets: (0 @ patternHeight negated corner: 0 @ 0)).
	window
		addMorph: row
		fullFrame: (LayoutFrame
				fractions: upperFraction
				offsets: (0 @ offset corner: 0 @ 0)).
	Preferences alternativeWindowLook
		ifTrue: [row borderWidth: 2] ifFalse: [row borderWidth: 0]! !

!FileList class methodsFor: 'instance creation' stamp: 'di 10/18/1999 22:34'!
openMorphOn: aFileStream editString: editString 
	"Open a morphic view of a FileList on the given file."
	| fileModel window fileContentsView |

	fileModel _ FileList new setFileStream: aFileStream.	"closes the stream"
	window _ (SystemWindow labelled: aFileStream fullName) model: fileModel.

	window addMorph: (fileContentsView _ PluggableTextMorph on: fileModel 
			text: #contents accept: #put:
			readSelection: #contentsSelection 
			menu: #fileContentsMenu:shifted:)
		frame: (0@0 corner: 1@1).
	editString ifNotNil: [fileContentsView editString: editString.
			fileContentsView hasUnacceptedEdits: true].

	^ window! !


!FileList2 methodsFor: 'drag''n''drop' stamp: 'nk 6/15/2003 22:00'!
isDirectoryList: aMorph
	^aMorph isKindOf: SimpleHierarchicalListMorph! !

!FileList2 methodsFor: 'user interface' stamp: 'rww 12/13/2003 13:07'!
morphicDirectoryTreePaneFiltered: aSymbol
	^(SimpleHierarchicalListMorph 
		on: self
		list: aSymbol
		selected: #currentDirectorySelected
		changeSelected: #setSelectedDirectoryTo:
		menu: #volumeMenu:
		keystroke: nil)
			autoDeselect: false;
			enableDrag: false;
			enableDrop: true;
			yourself
		
! !

!FileList2 methodsFor: 'user interface' stamp: 'RAA 6/16/2000 10:53'!
morphicFileContentsPane

	^PluggableTextMorph 
		on: self 
		text: #contents 
		accept: #put:
		readSelection: #contentsSelection 
		menu: #fileContentsMenu:shifted:
! !

!FileList2 methodsFor: 'user interface' stamp: 'nk 6/15/2003 13:05'!
morphicFileListPane

	^(PluggableListMorph 
		on: self 
		list: #fileList 
		selected: #fileListIndex
		changeSelected: #fileListIndex: 
		menu: #fileListMenu:)
			enableDrag: true;
			enableDrop: false;
			yourself

! !

!FileList2 methodsFor: 'user interface' stamp: 'RAA 6/16/2000 10:57'!
morphicPatternPane

	^PluggableTextMorph 
		on: self 
		text: #pattern 
		accept: #pattern:
		
! !


!FileList2 class methodsFor: 'morphic ui' stamp: 'bkv 11/12/2002 16:55'!
morphicViewFolderSelector: aDir
	"Answer a tool that allows the user to select a folder"

	| aFileList window fixedSize |
	aFileList _ self new directory: aDir.
	aFileList optionalButtonSpecs: aFileList servicesForFolderSelector.
	window _ (SystemWindow labelled: aDir pathName) model: aFileList.
	aFileList modalView: window.

	fixedSize _ 25.
	self addFullPanesTo: window from: {
		{self textRow: 'Please select a folder'. 0 @ 0 corner: 1 @ 0. 
				0@0 corner: 0@fixedSize}.
		{aFileList optionalButtonRow. 0 @ 0 corner: 1 @ 0. 
				0@fixedSize corner: 0@(fixedSize * 2)}.
		{aFileList morphicDirectoryTreePane. 0@0 corner: 1@1.
				0@(fixedSize * 2) corner: 0@0}.
	}.
	aFileList postOpen.
	^ window ! !

!FileList2 class methodsFor: 'morphic ui' stamp: 'RAA 1/8/2001 21:39'!
morphicViewNoFile

	| dir aFileList window midLine fixedSize |

	dir _ FileDirectory default.
	aFileList _ self new directory: dir.
	window _ (SystemWindow labelled: dir pathName) model: aFileList.

	fixedSize _ 25.
	midLine _ 0.4.
	self addFullPanesTo: window from: {
		{aFileList morphicPatternPane. 0@0 corner: 0.3@0. 0@0 corner: 0@fixedSize}.
		{aFileList optionalButtonRow. 0.3 @ 0 corner: 1@0. 0@0 corner: 0@fixedSize}.
		{aFileList morphicDirectoryTreePane. 0@0 corner: midLine@1. 0@fixedSize corner: 0@0}.
		{aFileList morphicFileListPane. midLine @ 0 corner: 1@1. 0@fixedSize corner: 0@0}.
	}.
	aFileList postOpen.
	^ window ! !

!FileList2 class methodsFor: 'utility' stamp: 'RAA 1/8/2001 21:23'!
addFullPanesTo: window from: aCollection

	| frame |

	aCollection do: [ :each |
		frame _ LayoutFrame 
			fractions: each second 
			offsets: each third.
		window addMorph: each first fullFrame: frame.
	]! !

!FileList2 class methodsFor: 'utility' stamp: 'RAA 3/6/2001 12:39'!
textRow: aString 

	^AlignmentMorph newRow 
		wrapCentering: #center; cellPositioning: #leftCenter;
		color: Color transparent;
		layoutInset: 0;
		addMorph: (
			AlignmentMorph newColumn
			wrapCentering: #center; cellPositioning: #topCenter;
			color: Color transparent;
			vResizing: #shrinkWrap;
			layoutInset: 0;
			addMorph: (
				AlignmentMorph newRow
				wrapCentering: #center; cellPositioning: #leftCenter;
				color: Color transparent;
				hResizing: #shrinkWrap;
				vResizing: #shrinkWrap;
				layoutInset: 0;
				addMorph: ((StringMorph contents: aString) color: Color blue; lock)
			)
		)! !

!FileList2 class methodsFor: '*smloader-extension' stamp: 'btr 1/30/2004 00:56'!
morphicViewOnDirectory: aFileDirectory
	| aFileList window fileListBottom midLine fileListTopOffset buttonPane |

	aFileList _ self new directory: aFileDirectory.
	window _ (SystemWindow labelled: aFileDirectory pathName) model: aFileList.

	fileListTopOffset _ (TextStyle defaultFont pointSize * 2) + 14.
	fileListBottom _ 0.4.
	midLine _ 0.4.
	buttonPane _ aFileList optionalButtonRow addMorph:
		(aFileList morphicPatternPane vResizing: #spaceFill; yourself).
	self addFullPanesTo: window from: {
		{buttonPane. 0@0 corner: 1@0. 0@0 corner: 0@fileListTopOffset}.
		{aFileList morphicDirectoryTreePane. 0@0 corner: midLine@fileListBottom. 
					0@fileListTopOffset corner: 0@0}.
		{aFileList morphicFileListPane. midLine @ 0 corner: 1@fileListBottom. 
					0@fileListTopOffset corner: 0@0}.
		{aFileList morphicFileContentsPane. 0@fileListBottom corner: 1@1. nil}.
	}.
	aFileList postOpen.
	^ window ! !


!FillInTheBlank class methodsFor: 'private' stamp: 'sma 6/18/2000 10:39'!
fillInTheBlankMorphClass
	"By factoring out this class references, it becomes possible to discard 
	morphic by simply removing this class.  All calls to this method needs
	to be protected by 'Smalltalk isMorphic' tests."

	^ FillInTheBlankMorph! !


!Inspector methodsFor: 'menu commands' stamp: 'tk 10/18/2002 17:13'!
addCollectionItemsTo: aMenu
	"If the current selection is an appropriate collection, add items to aMenu that cater to that kind of selection"

	| sel |
	((((sel _ self selection) isMemberOf: Array) or: [sel isMemberOf: OrderedCollection]) and: 
		[sel size > 0]) ifTrue: [
			aMenu addList: #(
				('inspect element...'					inspectElement))].

	(sel isKindOf: MorphExtension) ifTrue: [
			aMenu addList: #(
				('inspect property...'				inspectElement))].! !


!Inspector class methodsFor: 'instance creation' stamp: 'RAA 12/19/2000 09:41'!
openAsMorphOn: anObject withLabel: aLabel
	"(Inspector openAsMorphOn: SystemOrganization) openInMVC"
	| window inspector |
	inspector _ self inspect: anObject.
	window _ (SystemWindow labelled: aLabel) model: inspector.
	window addMorph: (
		PluggableListMorph new
			doubleClickSelector: #inspectSelection;

			on: inspector list: #fieldList
			selected: #selectionIndex
			changeSelected: #toggleIndex:
			menu: ((inspector isMemberOf: DictionaryInspector)
					ifTrue: [#dictionaryMenu:]
					ifFalse: [#fieldListMenu:])
			keystroke: #inspectorKey:from:)
		frame: (0@0 corner: self horizontalDividerProportion @ self verticalDividerProportion).
	window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
				readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
		frame: (self horizontalDividerProportion @0 corner: 1@self verticalDividerProportion).
	window addMorph: ((PluggableTextMorph on: inspector text: #trash accept: #trash:
				readSelection: #contentsSelection menu: #codePaneMenu:shifted:)
					askBeforeDiscardingEdits: false)
		frame: (0@self verticalDividerProportion corner: 1@1).
	window setUpdatablePanesFrom: #(fieldList).
	window position: 16@0.  "Room for scroll bar."
	^ window! !


!InspectorBrowser class methodsFor: 'as yet unclassified' stamp: 'sw 10/19/1999 10:11'!
openAsMorphOn: anObject
	"(InspectorBrowser openAsMorphOn: SystemOrganization) openInMVC"
	| window inspector |
	inspector _ self inspect: anObject.
	window _ (SystemWindow labelled: anObject defaultLabelForInspector)
				model: inspector.

	window addMorph: (PluggableListMorph on: inspector list: #fieldList
				selected: #selectionIndex changeSelected: #toggleIndex: menu: #fieldListMenu:)
		frame: (0@0 corner: 0.3@0.5).
	window addMorph: (PluggableTextMorph on: inspector text: #contents accept: #accept:
				readSelection: nil menu: #codePaneMenu:shifted:)
		frame: (0.3@0 corner: 1.0@0.5).
	window addMorph: (PluggableListMorph on: inspector list: #msgList
				selected: #msgListIndex changeSelected: #msgListIndex: menu: #msgListMenu:)
		frame: (0@0.5 corner: 0.3@1.0).
	window addMorph: (PluggableTextMorph on: inspector text: #msgText accept: #msgAccept:from:
				readSelection: nil menu: #msgPaneMenu:shifted:)
		frame: (0.3@0.5 corner: 1.0@1.0).
	
	window setUpdatablePanesFrom: #(fieldList msgList).
	window position: 16@0.  "Room for scroll bar."
	^ window! !


!MessageSet methodsFor: 'private' stamp: 'sw 6/12/2001 21:07'!
inMorphicWindowLabeled: labelString
	"Answer a morphic window with the given label that can display the receiver"

	| window listFraction |
	window _ (SystemWindow labelled: labelString) model: self.
	listFraction _ 0.2.
	window addMorph: self buildMorphicMessageList frame: (0@0 extent: 1@listFraction).
	self 
		addLowerPanesTo: window 
		at: (0@listFraction corner: 1@1) 
		with: nil.

	window setUpdatablePanesFrom: #(messageList).
	^ window! !


!MessageNames methodsFor: 'search' stamp: 'sw 7/30/2001 17:09'!
computeSelectorListFromSearchString
	"Compute selector list from search string"

	| raw sorted |
	searchString _ searchString asString copyWithout: $ .
	selectorList _ Cursor wait showWhile:
		[raw _ (Symbol selectorsContaining: searchString).
		sorted _ raw as: SortedCollection.
		sorted sortBlock: [:x :y | x asLowercase <= y asLowercase].
		sorted asArray].
	selectorList size > 19 ifFalse: "else the following filtering is considered too expensive.  This 19 should be a system-maintained Parameter, someday"
		[selectorList _ Smalltalk selectorsWithAnyImplementorsIn: selectorList].
	^ selectorList! !

!MessageNames methodsFor: 'search' stamp: 'sw 7/24/2001 01:49'!
showOnlyImplementedSelectors
	"Caution -- can be slow!!  Filter my selector list down such that it only shows selectors that are actually implemented somewhere in the system."

	self okToChange ifTrue:
		[Cursor wait showWhile:
			[selectorList _ Smalltalk selectorsWithAnyImplementorsIn: selectorList.
			self changed: #selectorList.
			self changed: #messageList]]! !

!MessageNames methodsFor: 'initialization' stamp: 'nk 4/28/2004 10:18'!
inMorphicWindowWithInitialSearchString: initialString
	"Answer a morphic window with the given initial search string, nil if none"

"MessageNames openMessageNames"

	| window selectorListView firstDivider secondDivider horizDivider typeInPane searchButton plugTextMor |
	window _ (SystemWindow labelled: 'Message Names') model: self.
	firstDivider _ 0.07.
	secondDivider _ 0.5.
	horizDivider _ 0.5.
	typeInPane _ AlignmentMorph newRow vResizing: #spaceFill; height: 14.
	typeInPane hResizing: #spaceFill.
	typeInPane listDirection: #leftToRight.

	plugTextMor _ PluggableTextMorph on: self
					text: #searchString accept: #searchString:notifying:
					readSelection: nil menu: nil.
	plugTextMor setProperty: #alwaysAccept toValue: true.
	plugTextMor askBeforeDiscardingEdits: false.
	plugTextMor acceptOnCR: true.
	plugTextMor setTextColor: Color brown.
	plugTextMor setNameTo: 'Search'.
	plugTextMor vResizing: #spaceFill; hResizing: #spaceFill.
	plugTextMor hideScrollBarsIndefinitely.
	plugTextMor setTextMorphToSelectAllOnMouseEnter.

	searchButton _ SimpleButtonMorph new 
		target: self;
		beTransparent;
		label: 'Search';
		actionSelector: #doSearchFrom:;
		arguments: {plugTextMor}.
	searchButton setBalloonText: 'Type some letters into the pane at right, and then press this Search button (or hit RETURN) and all method selectors that match what you typed will appear in the list pane below.  Click on any one of them, and all the implementors of that selector will be shown in the right-hand pane, and you can view and edit their code without leaving this tool.'.

	typeInPane addMorphFront: searchButton.
	typeInPane addTransparentSpacerOfSize: 6@0.
	typeInPane addMorphBack: plugTextMor.
	initialString isEmptyOrNil ifFalse:
		[plugTextMor setText: initialString].

	window addMorph: typeInPane frame: (0@0 corner: horizDivider @ firstDivider).

	selectorListView _ PluggableListMorph on: self
		list: #selectorList
		selected: #selectorListIndex
		changeSelected: #selectorListIndex:
		menu: #selectorListMenu:
		keystroke: #selectorListKey:from:.
	selectorListView menuTitleSelector: #selectorListMenuTitle.
	window addMorph: selectorListView frame: (0 @ firstDivider corner: horizDivider @ secondDivider).

	window addMorph: self buildMorphicMessageList frame: (horizDivider @ 0 corner: 1@ secondDivider).

	self 
		addLowerPanesTo: window 
		at: (0 @ secondDivider corner: 1@1) 
		with: nil.

	initialString isEmptyOrNil ifFalse:
		[self searchString: initialString notifying: nil].
	^ window! !


!PackagePaneBrowser methodsFor: 'initialize-release' stamp: 'RAA 2/6/2001 12:50'!
openAsMorphEditing: editString 
	"Create a pluggable version of all the views for a Browser, including 
	views and controllers."
	"PackagePaneBrowser openBrowser"

	| listHeight window |
	listHeight _ 0.4.
	(window _ SystemWindow labelled: 'later') model: self.
	window
		addMorph: (PluggableListMorph
				on: self
				list: #packageList
				selected: #packageListIndex
				changeSelected: #packageListIndex:
				menu: #packageMenu:
				keystroke: #packageListKey:from:)
		frame: (0 @ 0 extent: 0.15 @ listHeight).
	window
		addMorph: self buildMorphicSystemCatList
		frame: (0.15 @ 0 extent: 0.2 @ listHeight).
	self
		addClassAndSwitchesTo: window
		at: (0.35 @ 0 extent: 0.25 @ listHeight)
		plus: 0.
	window
		addMorph: self buildMorphicMessageCatList
		frame: (0.6 @ 0 extent: 0.15 @ listHeight).
	window
		addMorph: self buildMorphicMessageList
		frame: (0.75 @ 0 extent: 0.25 @ listHeight).
	self
		addLowerPanesTo: window
		at: (0 @ listHeight corner: 1 @ 1)
		with: editString.
	window setUpdatablePanesFrom: #(#packageList #systemCategoryList #classList #messageCategoryList #messageList ).
	^ window! !


!SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'RAA 5/29/2001 14:45'!
markMatchingClasses
	"If an example is used, mark classes matching the example instance with an asterisk."

	| unmarkedClassList firstPartOfSelector receiverString receiver |

	self flag: #mref.	"allows for old-fashioned style"

	"Only 'example' queries can be marked."
	(contents asString includes: $.) ifFalse: [^ self].

	unmarkedClassList _ classList copy.

	"Get the receiver object of the selected statement in the message list."
	firstPartOfSelector _ (Scanner new scanTokens: (selectorList at: selectorIndex)) second.
	receiverString _ (ReadStream on: (selectorList at: selectorIndex))
						upToAll: firstPartOfSelector.
	receiver _ Compiler evaluate: receiverString.

	unmarkedClassList do: [ :classAndMethod | | class |
		(classAndMethod isKindOf: MethodReference) ifTrue: [
			(receiver isKindOf: classAndMethod actualClass) ifTrue: [
				classAndMethod stringVersion: '*', classAndMethod stringVersion..
			]
		] ifFalse: [
			class _ Compiler evaluate:
					((ReadStream on: classAndMethod) upToAll: firstPartOfSelector).
			(receiver isKindOf: class) ifTrue: [
				classList add: '*', classAndMethod.
				classList remove: classAndMethod
			]
		].
	].
! !

!SelectorBrowser methodsFor: 'as yet unclassified' stamp: 'dew 4/25/2000 18:36'!
messageListIndex: anInteger 
	"Set the selected message selector to be the one indexed by anInteger.  Find all classes it is in."

	selectorIndex _ anInteger.
	selectorIndex = 0 ifTrue: [^ self].

	classList _ Smalltalk allImplementorsOf: self selectedMessageName.
	self markMatchingClasses.
	classListIndex _ 0.
	self changed: #messageListIndex.		"update my selection"
	self changed: #classList.! !


!StringMorph methodsFor: 'layout' stamp: 'ar 11/9/2000 18:46'!
minHeight
	^self fontToUse height! !

!StringMorph methodsFor: 'printing' stamp: 'sw 6/6/2001 13:34'!
boundsForBalloon
	"Some morphs have bounds that are way too big.  This is a contorted way of making things work okay in PluggableListMorphs, whose list elements historically have huge widths"

	| ownerOwner |
	^ ((owner notNil and: [(ownerOwner _ owner owner) notNil]) and:
			[ownerOwner isKindOf: PluggableListMorph])
		ifTrue:
			[self boundsInWorld intersect: ownerOwner boundsInWorld]
		ifFalse:
			[super boundsForBalloon]! !


!BorderedStringMorph methodsFor: 'initialization' stamp: 'ar 12/14/2001 20:02'!
initWithContents: aString font: aFont emphasis: emphasisCode
	super initWithContents: aString font: aFont emphasis: emphasisCode.
	self borderStyle: (SimpleBorder width: 1 color: Color white).! !

!BorderedStringMorph methodsFor: 'initialization' stamp: 'ar 12/12/2001 03:03'!
initialize
	super initialize.
	self borderStyle: (SimpleBorder width: 1 color: Color white).! !


!IndentingListItemMorph methodsFor: 'initialization' stamp: 'RAA 7/15/1998 00:14'!
initialize

	super initialize.
	indentLevel := 0.
	isExpanded := false.! !


!MenuItemMorph methodsFor: 'accessing' stamp: 'nk 3/10/2004 15:55'!
contents: aString withMarkers: aBool inverse: inverse 
	"Set the menu item entry. If aBool is true, parse aString for embedded markers."

	| markerIndex marker |
	self contentString: nil.	"get rid of old"
	aBool ifFalse: [^super contents: aString].
	self removeAllMorphs.	"get rid of old markers if updating"
	self hasIcon ifTrue: [ self icon: nil ].
	(aString notEmpty and: [aString first = $<]) 
		ifFalse: [^super contents: aString].
	markerIndex := aString indexOf: $>.
	markerIndex = 0 ifTrue: [^super contents: aString].
	marker := (aString copyFrom: 1 to: markerIndex) asLowercase.
	(#('<on>' '<off>' '<yes>' '<no>') includes: marker) 
		ifFalse: [^super contents: aString].
	self contentString: aString.	"remember actual string"
	marker := (marker = '<on>' or: [marker = '<yes>']) ~= inverse 
				ifTrue: [self onImage]
				ifFalse: [self offImage].
	super contents:  (aString copyFrom: markerIndex + 1 to: aString size).
	"And set the marker"
	marker := ImageMorph new image: marker.
	marker position: self left @ (self top + 2).
	self addMorphFront: marker! !

!MenuItemMorph methodsFor: 'events' stamp: 'RAA 1/18/2001 18:21'!
invokeWithEvent: evt
	"Perform the action associated with the given menu item."

	| selArgCount w |
	self isEnabled ifFalse: [^ self].
	target class == HandMorph ifTrue: [(self notObsolete) ifFalse: [^ self]].
	owner ifNotNil:[self isStayUpItem ifFalse:[
		self flag: #workAround. "The tile system invokes menus straightforwardly so the menu might not be in the world."
		(w _ self world) ifNotNil:[
			owner deleteIfPopUp: evt.
			"Repair damage before invoking the action for better feedback"
			w displayWorldSafely]]].
	selector ifNil:[^self].
	Cursor normal showWhile: [  "show cursor in case item opens a new MVC window"
		(selArgCount _ selector numArgs) = 0
			ifTrue:
				[target perform: selector]
			ifFalse:
				[selArgCount = arguments size
					ifTrue: [target perform: selector withArguments: arguments]
					ifFalse: [target perform: selector withArguments: (arguments copyWith: evt)]]].! !

!MenuItemMorph methodsFor: 'grabbing' stamp: 'spfa 3/13/2004 18:34'!
aboutToBeGrabbedBy: aHand
	"Don't allow the receiver to act outside a Menu"
	| menu box |
	(owner notNil and:[owner submorphs size = 1]) ifTrue:[
		"I am a lonely menuitem already; just grab my owner"
		owner stayUp: true.
		^owner 	aboutToBeGrabbedBy: aHand].
	box _ self bounds.
	menu _ MenuMorph new defaultTarget: nil.
	menu addMorphFront: self.
	menu bounds: box.
	menu stayUp: true.
	self isSelected: false.
	^menu! !

!MenuItemMorph methodsFor: 'grabbing' stamp: 'spfa 3/13/2004 18:32'!
duplicateMorph: evt
	"Make and return a duplicate of the receiver's argument"
	| dup menu |
	dup _ self duplicate isSelected: false.
	menu _ MenuMorph new defaultTarget: nil.
	menu addMorphFront: dup.
	menu bounds: self bounds.
	menu stayUp: true.
	evt hand grabMorph: menu from: owner. "duplicate was ownerless so use #grabMorph:from: here"
	^menu! !

!MenuItemMorph methodsFor: 'private' stamp: 'di 2/23/98 16:24'!
deselectItem
	| item |
	self isSelected: false.
	subMenu ifNotNil: [subMenu deleteIfPopUp].
	(owner isKindOf: MenuMorph) ifTrue:
		[item _ owner popUpOwner.
		(item isKindOf: MenuItemMorph) ifTrue: [item deselectItem]].
! !

!MenuItemMorph methodsFor: 'private' stamp: 'ar 9/18/2000 10:27'!
notObsolete
	"Provide backward compatibility with messages being sent to the Hand.  Remove this when no projects made prior to 2.9 are likely to be used.  If this method is removed early, the worst that can happen is a notifier when invoking an item in an obsolete menu."

	(HandMorph canUnderstand: (selector)) ifTrue: [^ true]. 	"a modern one"

	self inform: 'This world menu is obsolete.
Please dismiss the menu and open a new one.'.
	^ false
! !


!StringMorph class methodsFor: 'testing' stamp: 'di 5/6/1998 21:07'!
test
	"Return a morph with lots of strings for testing display speed."
	| c |
	c _ AlignmentMorph newColumn.
	SystemOrganization categories do:
		[:cat | c addMorph: (StringMorph new contents: cat)].
	^ c! !

!StringMorph class methodsFor: 'testing' stamp: 'di 5/6/1998 21:08'!
test2
	"Return a morph with lots of strings for testing display speed."
	| c r |
	c _ AlignmentMorph newColumn.
	SystemOrganization categories reverseDo:
		[:cat | c addMorph: (StringMorph new contents: cat)].
	r _ RectangleMorph new extent: c fullBounds extent.
	c submorphsDo: [:m | r addMorph: m].
	^ r
! !


!SyntaxError class methodsFor: 'instance creation' stamp: 'di 8/17/1998 10:22'!
buildMorphicViewOn: aSyntaxError
	"Answer an Morphic view on the given SyntaxError."
	| window |
	window _ (SystemWindow labelled: 'Syntax Error') model: aSyntaxError.

	window addMorph: (PluggableListMorph on: aSyntaxError list: #list
			selected: #listIndex changeSelected: nil menu: #listMenu:)
		frame: (0@0 corner: 1@0.15).

	window addMorph: (PluggableTextMorph on: aSyntaxError text: #contents
			accept: #contents:notifying: readSelection: #contentsSelection
			menu: #codePaneMenu:shifted:)
		frame: (0@0.15 corner: 1@1).

	^ window openInWorldExtent: 380@220! !


!SystemDictionary methodsFor: 'class names' stamp: 'sw 10/28/96'!
renameClassNamed: oldName as: newName
	"Invoked from fileouts:  if there is currently a class in the system named oldName, then rename it to newName.  If anything untoward happens, report it in the Transcript.  "

	| oldClass |
	(oldClass _ self at: oldName asSymbol ifAbsent: [nil]) == nil
		ifTrue:
			[Transcript cr; show: 'Class-rename for ', oldName, ' ignored because ', oldName, ' does not exist.'.
			^ self].

	oldClass rename: newName! !

!SystemDictionary methodsFor: 'housekeeping' stamp: 'ar 8/6/2001 22:50'!
browseObsoleteMethodReferences
	"Open a browser on all referenced behaviors that are obsolete"
	"Smalltalk browseObsoleteMethodReferences"
	| list |
	list _ self obsoleteMethodReferences.
	self browseMessageList: list name:'Method referencing obsoletes' autoSelect: nil! !


!SystemWindow methodsFor: 'drawing' stamp: 'di 8/16/1998 01:14'!
areasRemainingToFill: aRectangle
	| areas |
	(areas _ super areasRemainingToFill: aRectangle) isEmpty
		ifTrue: [^ areas "good news -- complete occlusion"].
	"Check for special case that this is scrollbar damage"
	((bounds topLeft - (14@0) corner: bounds bottomRight) containsRect: aRectangle) ifTrue:
		[paneMorphs do: [:p | ((p isKindOf: ScrollPane) and: [p scrollBarFills: aRectangle])
							ifTrue: [^ Array new]]].
	^ areas! !

!SystemWindow methodsFor: 'initialization' stamp: 'nk 6/2/2004 11:27'!
addLabelArea

	labelArea := (AlignmentMorph newSpacer: Color transparent)
			vResizing: #spaceFill;
			layoutPolicy: ProportionalLayout new.
	self addMorph: labelArea.! !

!SystemWindow methodsFor: 'label' stamp: 'dew 8/3/2004 01:12'!
setLabel: aString
	| frame |
	labelString _ aString.
	label ifNil: [^ self].
	label contents: aString.
	self labelWidgetAllowance.  "Sets it if not already"
	self isCollapsed
		ifTrue: [self extent: (label width + labelWidgetAllowance) @ (self labelHeight + 2)]
		ifFalse: [label fitContents; setWidth: (label width min: bounds width - labelWidgetAllowance).
				label align: label bounds topCenter with: bounds topCenter + (0@borderWidth).
				collapsedFrame ifNotNil:
					[collapsedFrame _ collapsedFrame withWidth: label width + labelWidgetAllowance]].
	frame _ LayoutFrame new.
	frame leftFraction: 0.5;
		 topFraction: 0.5;
		 leftOffset: label width negated // 2;
		 topOffset: label height negated // 2.
	label layoutFrame: frame.
! !

!SystemWindow methodsFor: 'menu' stamp: 'dgd 8/30/2003 16:40'!
buildWindowMenu
	| aMenu |
	aMenu _ MenuMorph new defaultTarget: self.
	aMenu add: 'change title...' translated action: #relabel.
	aMenu addLine.
	aMenu add: 'send to back' translated action: #sendToBack.
	aMenu add: 'make next-to-topmost' translated action: #makeSecondTopmost.
	aMenu addLine.
	self mustNotClose
		ifFalse:
			[aMenu add: 'make unclosable' translated action: #makeUnclosable]
		ifTrue:
			[aMenu add: 'make closable' translated action: #makeClosable].
	aMenu
		add: (self isSticky ifTrue: ['make draggable'] ifFalse: ['make undraggable']) translated 
		action: #toggleStickiness.
	aMenu addLine.
	aMenu add: 'full screen' translated action: #fullScreen.
	self isCollapsed ifFalse: [aMenu add: 'window color...' translated action: #setWindowColor].
	^aMenu! !

!SystemWindow methodsFor: 'menu' stamp: 'sw 10/6/2000 14:01'!
changeColor
	"Change the color of the receiver -- triggered, e.g. from a menu.  This variant allows the recolor triggered from the window's halo recolor handle to have the same result as choosing change-window-color from the window-title menu"

	ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: self activeHand;
		target: self;
		selector: #setWindowColor:;
		originalColor: self color;
		putUpFor: self near: self fullBoundsInWorld! !

!SystemWindow methodsFor: 'menu' stamp: 'sw 9/6/2000 18:46'!
setWindowColor
	"Allow the user to select a new basic color for the window"

	ColorPickerMorph new
		choseModalityFromPreference;
		sourceHand: self activeHand;
		target: self;
		selector: #setWindowColor:;
		originalColor: self paneColorToUse;
		putUpFor: self
			near: self fullBounds! !

!SystemWindow methodsFor: 'menu' stamp: 'nb 6/17/2003 12:25'!
setWindowColor: incomingColor
	| existingColor aColor |
	incomingColor ifNil: [^ self].  "it happens"
	aColor _ incomingColor asNontranslucentColor.
	(aColor = ColorPickerMorph perniciousBorderColor 
		or: [aColor = Color black]) ifTrue: [^ self].
	existingColor _ self paneColorToUse.
	existingColor ifNil: [^ Beeper beep].
	Preferences alternativeWindowLook ifFalse:[
		(self allMorphs copyWithout: self) do:[:aMorph |
			((aMorph isKindOf: PluggableButtonMorph) and: [aMorph offColor = existingColor])
				ifTrue:
					[aMorph onColor: aColor darker offColor: aColor].
			aMorph color = existingColor
				ifTrue:
					[aMorph color: aColor]]].
	self paneColor: aColor.
	self setStripeColorsFrom: aColor.
	self changed.! !

!SystemWindow methodsFor: 'panes' stamp: 'RAA 1/8/2001 20:37'!
addMorph: aMorph frame: relFrame
	| frame |
	frame _ LayoutFrame new.
	frame 
		leftFraction: relFrame left; 
		rightFraction: relFrame right; 
		topFraction: relFrame top; 
		bottomFraction: relFrame bottom.
	self addMorph: aMorph fullFrame: frame.

! !

!SystemWindow methodsFor: 'panes' stamp: 'RAA 1/10/2001 19:01'!
setUpdatablePanesFrom: getSelectors
	| aList aPane possibles |
	"Set my updatablePanes inst var to the list of panes which are list panes with the given get-list selectors.  Order is important here!!  Note that the method is robust in the face of panes not found, but a warning is printed in the transcript in each such case"

	aList _ OrderedCollection new.
	possibles _ OrderedCollection new.
	self allMorphsDo: [ :pane | 
		(pane isKindOf: PluggableListMorph) ifTrue: [
			possibles add: pane.
		].
	].

	getSelectors do: [:sel | 
		aPane _ possibles detect: [ :pane | pane getListSelector == sel] ifNone: [nil].
		aPane
			ifNotNil:
				[aList add: aPane]
			ifNil:
				[Transcript cr; show: 'Warning: pane ', sel, ' not found.']].
	updatablePanes _ aList asArray! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jm 6/17/1998 11:55'!
mouseLeaveEvent: event fromPane: pane
	"For backward compatibility only.  Not used by any newly created window"
	(pane isKindOf: ScrollPane) ifTrue: [pane mouseLeave: event].
! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'aoy 2/15/2003 21:06'!
spawnPaneFrameHandle: event 
	| resizer localPt side growingPane newBounds adjoiningPanes limit cursor |
	(self world firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	((self innerBounds withHeight: self labelHeight + 4) 
		containsPoint: event cursorPoint) 
			ifTrue: [^self	"in label or top of top pane"].
	growingPane := self paneWithLongestSide: [:s | side := s]
				near: event cursorPoint.
	growingPane ifNil: [^self].
	"don't resize pane side coincident with window side - RAA 5 jul 2000"
	(growingPane perform: side) = (self innerBounds perform: side) 
		ifTrue: [^self].
	(side == #top and: [growingPane top = self panelRect top]) ifTrue: [^self].
	adjoiningPanes := paneMorphs 
				select: [:pane | pane bounds bordersOn: growingPane bounds along: side].
	limit := adjoiningPanes isEmpty 
				ifFalse: 
					[(adjoiningPanes collect: [:pane | pane bounds perform: side]) 
						perform: ((#(#top #left) includes: side) ifTrue: [#max] ifFalse: [#min])]
				ifTrue: [self bounds perform: side].
	cursor := Cursor resizeForEdge: side.
	resizer := (NewHandleMorph new)
				sensorMode: self fastFramingOn;
				followHand: event hand
					forEachPointDo: 
						[:p | 
						localPt := self pointFromWorld: p.
						newBounds := growingPane bounds 
									withSideOrCorner: side
									setToPoint: localPt
									minExtent: 40 @ 20
									limit: limit.
						self fastFramingOn 
							ifTrue: 
								["For fast display, only higlight the rectangle during loop"

								Cursor currentCursor == cursor 
									ifFalse: 
										[(event hand)
											visible: false;
											refreshWorld;
											visible: true.
										cursor show].
								newBounds := growingPane bounds newRectButtonPressedDo: 
												[:f | 
												growingPane bounds 
													withSideOrCorner: side
													setToPoint: (self pointFromWorld: Sensor cursorPoint)
													minExtent: 40 @ 20
													limit: limit].].
								self 
									reframePanesAdjoining: growingPane
									along: side
									to: newBounds.
]
					lastPointDo: [:p | ]
					withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !

!SystemWindow methodsFor: 'stepping' stamp: 'di 4/9/2001 17:04'!
stepAt: millisecondClockValue
	"If the receiver is not collapsed, step it, after first stepping the model."

	(isCollapsed not or: [self wantsStepsWhenCollapsed]) ifTrue:
		[model ifNotNil: [model stepAt: millisecondClockValue in: self].
		super stepAt: millisecondClockValue "let player, if any, step"]

"Since this method ends up calling step, the model-stepping logic should not be duplicated there."! !


!SystemWindow class methodsFor: 'instance creation' stamp: 'di 2/3/98 11:54'!
includeInNewMorphMenu
	"Include my subclasses but not me"
	^ self ~~ SystemWindow! !


!TableLayout methodsFor: 'layout' stamp: 'ar 12/18/2000 13:45'!
computeCellSizes: aMorph in: newBounds horizontal: aBool
	"Step 1: Compute the minimum extent for all the children of aMorph"
	| cells cell size block maxCell minSize maxSize |
	cells _ WriteStream on: (Array new: aMorph submorphCount).
	minSize _ properties minCellSize asPoint.
	maxSize _ properties maxCellSize asPoint.
	aBool ifTrue:[
		minSize _ minSize transposed.
		maxSize _ maxSize transposed].
	maxCell _ 0@0.
	block _ [:m|
		m disableTableLayout ifFalse:[
			size _ m minExtent asIntegerPoint.
			cell _ LayoutCell new target: m.
			aBool ifTrue:[
				cell hSpaceFill: m hResizing == #spaceFill.
				cell vSpaceFill: m vResizing == #spaceFill.
			] ifFalse:[
				cell hSpaceFill: m vResizing == #spaceFill.
				cell vSpaceFill: m hResizing == #spaceFill.
				size _ size transposed.
			].
			size _ (size min: maxSize) max: minSize.
			cell cellSize: size.
			maxCell _ maxCell max: size.
			cells nextPut: cell]].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].
	^maxCell -> cells contents! !

!TableLayout methodsFor: 'layout' stamp: 'ar 10/31/2000 22:50'!
computeGlobalCellArrangement: cells in: newBounds horizontal: aBool wrap: wrap spacing: spacing
	"Compute number of cells we can put in each row/column. The returned array contains a list of all the cells we can put into the row/column at each level.
	Note: The arrangement is so that the 'x' value of each cell advances along the list direction and the 'y' value along the wrap direction. The returned arrangement has an extra cell at the start describing the width and height of the row."
	| output maxExtent n cell first last hFill vFill |
	output _ (WriteStream on: Array new).
	first _ last _ nil.
	maxExtent _ cells inject: 0@0 into:[:size :c| size max: c cellSize "e.g., minSize"].
	spacing == #globalSquare ifTrue:[maxExtent _ (maxExtent x max: maxExtent y) asPoint].
	n _ (wrap // maxExtent x) max: 1.
	hFill _ vFill _ false.
	1 to: cells size do:[:i|
		cell _ cells at: i.
		hFill _ hFill or:[cell hSpaceFill].
		vFill _ vFill or:[cell vSpaceFill].
		cell cellSize: maxExtent.
		first ifNil:[first _ last _ cell] ifNotNil:[last nextCell: cell. last _ cell].
		(i \\ n) = 0 ifTrue:[
			last _ LayoutCell new.
			last cellSize: (maxExtent x * n) @ (maxExtent y).
			last hSpaceFill: hFill.
			last vSpaceFill: vFill.
			hFill _ vFill _ false.
			last nextCell: first.
			output nextPut: last.
			first _ nil]].
	first ifNotNil:[
		last _ LayoutCell new.
		last cellSize: (maxExtent x * n) @ (maxExtent y). self flag: #arNote."@@@: n is not correct!!"
		last nextCell: first.
		output nextPut: last].
	^output contents
! !

!TableLayout methodsFor: 'utilities' stamp: 'ar 11/13/2000 18:26'!
indexForInserting: aPoint inList: morphList horizontal: aBool target: aMorph
	| box cmp1 cmp2 cmp3 noWrap |
	properties _ aMorph layoutProperties.
	noWrap _ properties wrapDirection == #none.
	aBool ifTrue:["horizontal"
		properties listDirection == #rightToLeft
			ifTrue:[cmp1 _ [:rect| aPoint x > rect left]]
			ifFalse:[cmp1 _ [:rect| aPoint x < rect right]].
		properties wrapDirection == #bottomToTop 
			ifTrue:[cmp2 _ [:rect| aPoint y > rect top].
					cmp3 _ [:rect| aPoint y > rect bottom]]
			ifFalse:[cmp2 _ [:rect| aPoint y < rect bottom].
					cmp3 _ [:rect| aPoint y < rect top]].
	] ifFalse:["vertical"
		properties listDirection == #bottomToTop 
			ifTrue:[cmp1 _ [:rect| aPoint y > rect top]]
			ifFalse:[cmp1 _ [:rect| aPoint y < rect bottom]].
		properties wrapDirection == #rightToLeft
			ifTrue:[cmp2 _ [:rect| aPoint x > rect left].
					cmp3 _ [:rect| aPoint x > rect right]]
			ifFalse:[cmp2 _ [:rect| aPoint x < rect right].
					cmp3 _ [:rect| aPoint x < rect left]].
	].
	morphList keysAndValuesDo:[:index :m|
		self flag: #arNote. "it is not quite clear if we can really use #fullBounds here..."
		box _ m fullBounds.
		noWrap ifTrue:[
			"Only in one direction"
			(cmp1 value: box) ifTrue:[^index]
		] ifFalse:[
			"Check for inserting before current row"
			(cmp3 value: box) ifTrue:[^index].
			"Check for inserting before current cell"
			((cmp1 value: box) and:[cmp2 value: box]) ifTrue:[^index]]].
	^morphList size + 1! !


!TestRunner methodsFor: 'interface opening' stamp: 'nk 4/28/2004 10:18'!
buildDetailsText
	detailsText _ PluggableTextMorph
				on: self
				text: #details
				accept: nil.
	detailsText hideScrollBarsIndefinitely.
	^detailsText! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 8/6/2003 08:36'!
buildErrorsList
	^PluggableListMorph
				on: self
				list: #errorsList
				selected: #selectedErrorTest
				changeSelected: #debugErrorTest:.
! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 8/6/2003 08:36'!
buildFailuresList
	^PluggableListMorph
				on: self
				list: #failuresList
				selected: #selectedFailureTest
				changeSelected: #debugFailureTest:.
! !

!TestRunner methodsFor: 'interface opening' stamp: 'sbw 9/26/2002 19:54'!
buildLowerPanes
	| failuresList errorsList row tHeight divider |
	row _ AlignmentMorph newColumn hResizing: #spaceFill;
				 vResizing: #spaceFill;
				 layoutInset: 0;
				 borderWidth: 1;
				 borderColor: Color black;
				 layoutPolicy: ProportionalLayout new.
	self buildPassFailText.
	self buildDetailsText.
	self buildTestsList.
	failuresList _ self buildFailuresList.
	errorsList _ self buildErrorsList.
	tHeight _ 26.
	divider _ Array new: 3.
	1
		to: divider size
		do: [:index | 
			divider at: index put: BorderedSubpaneDividerMorph forBottomEdge.
			Preferences alternativeWindowLook
				ifTrue: [(divider at: index) extent: 4 @ 4;
						 color: Color transparent;
						 borderColor: #raised;
						 borderWidth: 2]].
	row
		addMorph: (passFailText borderWidth: 0)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ 0 corner: 0 @ tHeight - 1)).
	row
		addMorph: (divider at: 1)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ (tHeight - 1) corner: 0 @ tHeight)).
	row
		addMorph: (detailsText borderWidth: 0)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ tHeight corner: 0 @ (2 * tHeight - 1))).
	row
		addMorph: (divider at: 2)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ (2 * tHeight - 1) corner: 0 @ (2 * tHeight))).
	row
		addMorph: (failuresList borderWidth: 0)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 0.6)
				offsets: (0 @ (2 * tHeight) corner: 0 @ -1)).
	row
		addMorph: (divider at: 3)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0.6 corner: 1 @ 0.6)
				offsets: (0 @ - 1 corner: 0 @ 0)).
	row
		addMorph: (errorsList borderWidth: 0)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0.6 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ 0)).
	^ row! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 4/28/2004 10:19'!
buildPassFailText
	passFailText _ PluggableTextMorph
				on: self
				text: #passFail
				accept: nil.
	passFailText hideScrollBarsIndefinitely.
	^ passFailText! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 12/19/2002 09:15'!
buildTestsList
	| column offset buttonRow |
	column _ AlignmentMorph newColumn hResizing: #spaceFill;
				 vResizing: #spaceFill;
				 layoutInset: 0;
				 borderWidth: 0;
				 borderColor: Color black;
				color: Color transparent;
				 layoutPolicy: ProportionalLayout new.
	testsList _ PluggableListMorphOfMany
				on: self
				list: #tests
				primarySelection: #selectedSuite
				changePrimarySelection: #selectedSuite:
				listSelection: #listSelectionAt:
				changeListSelection: #listSelectionAt:put:
				menu: #listMenu:shifted:.
	testsList autoDeselect: false.
	offset _ 0.
	self wantsOptionalButtons
		ifTrue: [offset _ TextStyle default lineGrid + 14 ].
	column
		addMorph: testsList
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ offset negated)).
	self wantsOptionalButtons
		ifTrue: [buttonRow _ self optionalButtonRow.
			buttonRow
				color: (Display depth <= 8
						ifTrue: [Color transparent]
						ifFalse: [Color gray alpha: 0.2]);
				 borderWidth: 0.
			Preferences alternativeWindowLook
				ifTrue: [buttonRow color: Color transparent.
					buttonRow
						submorphsDo: [:m | m borderWidth: 1;
								 borderColor: #raised]].
			column
				addMorph: buttonRow
				fullFrame: (LayoutFrame
						fractions: (0 @ 1 corner: 1 @ 1)
						offsets: (0 @ (offset - 1) negated corner: 0 @ 0))].
	^ column! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 12/19/2002 09:11'!
buildUpperControls
	| refreshButton filterButton stopButton runOneButton runButton row bWidth listsMorph |
	row _ BorderedMorph new
				hResizing: #spaceFill;
				 vResizing: #spaceFill;
				 borderWidth: 1;
				 borderColor: Color black;
				 layoutPolicy: ProportionalLayout new.
	row
		color: (Display depth <= 8
				ifTrue: [Color transparent]
				ifFalse: [Color gray alpha: 0.2]);
		 clipSubmorphs: true;
		 cellInset: 3;
		 borderWidth: 0.
	refreshButton _ self buildRefreshButton.
	filterButton _ self buildFilterButton.
	stopButton _ self buildStopButton.
	runOneButton _ self buildRunOneButton.
	runButton _ self buildRunButton.
	listsMorph _ self buildTestsList.
	bWidth _ 90.
	row
		addMorph: refreshButton
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 0 @ 0.33)
				offsets: (4 @ 2 corner: bWidth - 4 @ -2)).
	row
		addMorph: filterButton
		fullFrame: (LayoutFrame
				fractions: (0 @ 0.33 corner: 0 @ 0.66)
				offsets: (4 @ 2 corner: bWidth - 4 @ -2)).
	row
		addMorph: stopButton
		fullFrame: (LayoutFrame
				fractions: (0 @ 0.66 corner: 0 @ 1)
				offsets: (4 @ 2 corner: bWidth - 4 @ -2)).
	row
		addMorph: listsMorph
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (bWidth  @ 0 corner: bWidth negated @ 0)).
	row
		addMorph: runOneButton
		fullFrame: (LayoutFrame
				fractions: (1 @ 0 corner: 1 @ 0.5)
				offsets: (bWidth negated + 4 @ 2 corner: -4 @ -2)).
	row
		addMorph: runButton
		fullFrame: (LayoutFrame
				fractions: (1 @ 0.5 corner: 1 @ 1)
				offsets: (bWidth negated + 4 @ 2 corner: -4 @ -2)).
	Preferences alternativeWindowLook
		ifTrue: [row color: Color transparent.
			row
				submorphsDo: [:m | m borderWidth: 2;
						 borderColor: #raised]].
	^ row! !

!TestRunner methodsFor: 'interface opening' stamp: 'nk 8/6/2003 09:57'!
morphicWindow
	"TestRunner new openAsMorph"
	| upperRow lowerPanes fracYRatio divider window |
	window _ SystemWindow labelled: self windowLabel.
	window model: self.
	upperRow _ self buildUpperControls.
	lowerPanes _ self buildLowerPanes.
	fracYRatio _ 0.25.
	window
		addMorph: upperRow
		fullFrame: (LayoutFrame fractions: (0 @ 0 extent: 1 @ fracYRatio) offsets: (0@0 corner: 0@0)).
	divider _ BorderedSubpaneDividerMorph forBottomEdge.
	Preferences alternativeWindowLook
		ifTrue: [divider hResizing: #spaceFill;
				 color: Color transparent;
				 borderColor: #raised;
				 borderWidth: 1].
	window
		addMorph: divider
		fullFrame: (LayoutFrame
				fractions: (0 @ fracYRatio corner: 1 @ fracYRatio)
				offsets: (0 @ 0 corner: 0 @ 2)).

	window
		addMorph: lowerPanes
		fullFrame: (LayoutFrame fractions: (0 @ fracYRatio extent: 1 @ (1 - fracYRatio)) offsets: (0@0 corner: 0@0)).
	self refreshWindow.
	window extent: 460 @ 400.
	^window! !

!TestRunner methodsFor: 'menus' stamp: 'nk 8/6/2003 09:08'!
installProgressWatcher
	| win host |
	win _ self dependents first.
	host _ win submorphs first.
	progress _ ProgressMorph label: 'Test progress'.
	progress
		borderWidth: 0;
		position: host position;
		extent: host extent;
		color: Color transparent;
		wrapCentering: #center;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	win
		addMorph: progress 
		frame: (0.0 @ 0.7 extent: 1.0 @ 0.3).
! !

!TestRunner methodsFor: 'processing' stamp: 'nk 12/8/2002 11:46'!
runSuite: suite
	running ifNotNil: [ ^self inform: 'already running' ].
	suite addDependent: self.
	totalTests _ suite tests size.
	completedTests _ 0.
	self installProgressWatcher.
	runSemaphore initSignals.
	running _ [
            [ result _ suite run ]
	            ensure: [
		            running _ nil.
				suite removeDependent: self.
				runSemaphore signal.
				WorldState addDeferredUIMessage: [
					self removeProgressWatcher.
					self updateWindow: result.
			      	self changed: #runTests.
			      	self changed: #runOneTest.
				].
	            ].
     ] newProcess.
	self runWindow.
      self changed: #runTests.
      self changed: #runOneTest.
      running
	      priority: Processor userBackgroundPriority;
	      resume.
! !

!TestRunner methodsFor: 'updating' stamp: 'nk 8/6/2003 09:15'!
update: aParameter 
	"updates come in from another thread"
	(aParameter isKindOf: TestCase)
		ifTrue: [WorldState
				addDeferredUIMessage: [completedTests _ completedTests + 1.
					self updateProgressWatcher: aParameter printString]]
		ifFalse: [ super update: aParameter ]! !


!TestRunner class methodsFor: 'instance creation' stamp: 'Sames 4/11/2000
17:33'!
new

        ^super new initialize! !


!TextColor methodsFor: 'printing'!
printOn: strm
	super printOn: strm.
	strm nextPutAll: ' code: '; print: color! !


!TextColor class methodsFor: 'instance creation' stamp: 'tk 12/16/97 08:50'!
scanFrom: strm
	"read a color in the funny format used by Text styles on files. c125000255 or cblue;"

	| r g b |
	strm peek isDigit ifTrue: [
		r _ (strm next: 3) asNumber.
		g _ (strm next: 3) asNumber.
		b _ (strm next: 3) asNumber.
		^ self color: (Color r: r g: g b: b range: 255)].
	"A name of a color"
	^ self color: (Color perform: (strm upTo: $;) asSymbol)! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'RAA 5/5/2001 11:05'!
addNullLineWithIndex: index andRectangle: r

	lines addLast: (
		(
			TextLine 
				start: index 
				stop: index - 1
				internalSpaces: 0 
				paddingWidth: 0
		)
			rectangle: r;
			lineHeight: defaultLineHeight baseline: theTextStyle baseline
	)
! !


!TextContainer methodsFor: 'access' stamp: 'jm 11/19/97 19:28'!
paragraphClass
	^ NewParagraph! !


!TextMorph methodsFor: 'anchors' stamp: 'ar 8/10/2003 18:19'!
anchorMorph: aMorph at: aPoint type: anchorType
	| relPt index newText block |
	aMorph owner == self ifTrue:[self removeMorph: aMorph].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	self addMorphFront: aMorph.
	aMorph textAnchorType: anchorType.
	aMorph relativeTextAnchorPosition: nil.
	anchorType == #document ifTrue:[^self].
	relPt _ self transformFromWorld globalPointToLocal: aPoint.
	index _ (self paragraph characterBlockAtPoint: relPt) stringIndex.
	newText _ Text string: (String value: 1) attribute: (TextAnchor new anchoredMorph: aMorph).
	anchorType == #inline ifTrue:[
		self paragraph replaceFrom: index to: index-1 with: newText displaying: false.
	] ifFalse:[
		index _ index min: paragraph text size.
		index _ paragraph text string lastIndexOf: Character cr startingAt: index ifAbsent:[0].
		block _ paragraph characterBlockForIndex: index+1.
		aMorph relativeTextAnchorPosition: (relPt x - bounds left) @ (relPt y - block top ).
		self paragraph replaceFrom: index+1 to: index with: newText displaying: false.
	].
	self fit.! !

!TextMorph methodsFor: 'containment' stamp: 'di 11/4/97 15:37'!
fillingOnOff
	"Establish a container for this text, with opposite filling status"
	self setContainer:
	(container
		ifNil: [TextContainer new for: self minWidth: textStyle lineGrid*2]
		ifNotNil: [(container fillsOwner and: [container avoidsOcclusions not])
			ifTrue: [nil  "Return to simple rectangular bounds"]
			ifFalse: [container fillsOwner: container fillsOwner not]])! !

!TextMorph methodsFor: 'containment' stamp: 'di 11/4/97 15:37'!
occlusionsOnOff
	"Establish a container for this text, with opposite occlusion avoidance status"
	self setContainer:
	(container
	ifNil: [(TextContainer new for: self minWidth: textStyle lineGrid*2)
							fillsOwner: false; avoidsOcclusions: true]
	ifNotNil: [(container avoidsOcclusions and: [container fillsOwner not])
			ifTrue: [nil  "Return to simple rectangular bounds"]
			ifFalse: [container avoidsOcclusions: container avoidsOcclusions not]])! !

!TextMorph methodsFor: 'editing' stamp: 'di 10/5/1998 13:55'!
chooseStyle
	self editor changeStyle.
	self updateFromParagraph! !

!TextMorph methodsFor: 'editing' stamp: 'ar 9/22/2001 16:50'!
handleInteraction: interactionBlock fromEvent: evt
	"Perform the changes in interactionBlock, noting any change in selection
	and possibly a change in the size of the paragraph (ar 9/22/2001 - added for TextPrintIts)"
	"Also couple ParagraphEditor to Morphic keyboard events"
	| oldEditor oldParagraph oldSize |
	self editor sensor: (KeyboardBuffer new startingEvent: evt).
	oldEditor _ editor.
	oldParagraph _ paragraph.
	oldSize _ oldParagraph text size.

	self selectionChanged.  "Note old selection"

		interactionBlock value.

	(oldParagraph == paragraph) ifTrue:[
		"this will not work if the paragraph changed"
		editor _ oldEditor.     "since it may have been changed while in block"
	].
	self selectionChanged.  "Note new selection"
	(oldSize = paragraph text size)
		ifFalse:[self updateFromParagraph].
! !

!TextMorph methodsFor: 'initialization' stamp: 'di 6/22/2001 09:36'!
defaultColor
	"Return the default fill style for the receiver"
	^ Color black! !

!TextMorph methodsFor: 'menu' stamp: 'di 12/3/97 10:25'!
setCurveBaseline: evt
	| handle origin |
	origin _ evt cursorPoint.
	handle _ HandleMorph new forEachPointDo:
		[:newPoint | handle removeAllMorphs.
		handle addMorph:
			(PolygonMorph vertices: (Array with: origin with: newPoint)
				color: Color black borderWidth: 1 borderColor: Color black).
		container baseline: (newPoint - origin) y negated asInteger // 5.
		self paragraph composeAll].
	evt hand attachMorph: handle.
	handle startStepping	! !

!TextMorph methodsFor: 'private' stamp: 'jm 11/19/97 19:30'!
paragraphClass
	container ifNil: [^ NewParagraph].
	^ container paragraphClass! !

!TextMorph methodsFor: 'private' stamp: 'ar 8/10/2003 18:12'!
removedMorph: aMorph
	| range |
	range _ text find: (TextAnchor new anchoredMorph: aMorph).
	range ifNotNil:
		[self paragraph replaceFrom: range first to: range last
				with: Text new displaying: false.
		self fit].
	aMorph textAnchorType: nil.
	aMorph relativeTextAnchorPosition: nil.
	super removedMorph: aMorph.! !

!TextMorph methodsFor: 'private' stamp: 'di 11/30/97 12:13'!
selectionChanged
	self paragraph selectionRects do: [:r | self invalidRect: r]! !


!TextStyle class methodsFor: 'mime file in/out' stamp: 'nk 3/15/2004 19:25'!
replaceFontsIn: oldFontArray with: newStyle
	"
	TextStyle replaceFontsIn: (TextStyle looseFontsFromFamily: #Accuny) with: (TextStyle named: #Accuny)
	"
	"Try to find corresponding fonts in newStyle and substitute them for the fonts in oldFontArray"

	newStyle fontArray do: [ :newFont | newFont releaseCachedState ].

	oldFontArray do: [ :oldFont | | newFont |
		oldFont reset.
		newFont _ (newStyle fontOfPointSize: oldFont pointSize) emphasis: oldFont emphasis.
		oldFont becomeForward: newFont ].

	StringMorph allSubInstancesDo: [ :s | s layoutChanged ].
	TextMorph allSubInstancesDo: [ :s | s layoutChanged ].
	SystemWindow allInstancesDo: [ :w | [ w update: #relabel ] on: Error do: [ :ex | ] ].
	World ifNotNilDo: [ :w | w changed ].! !

!TextStyle class methodsFor: 'user interface' stamp: 'laza 3/25/2004 23:12'!
promptForFont: aPrompt andSendTo: aTarget withSelector: aSelector highlight: currentFont
	"Morphic Only!! prompt for a font and if one is provided, send it to aTarget using a message with selector aSelector."

	"TextStyle promptForFont: 'Choose system font:' andSendTo: Preferences withSelector: #setSystemFontTo:"
	"Derived from a method written by Robin Gibson"

        | menu subMenu currentTextStyle currentSize |
        currentTextStyle _ currentFont ifNotNil: [currentFont textStyleName].
        menu _ MenuMorph entitled: aPrompt.
        self actualTextStyles keys do: [:styleName|
                currentSize _  (styleName = currentTextStyle ifTrue: [currentFont pointSize]).
                subMenu _ self fontMenuForStyle: styleName target: aTarget selector: aSelector highlight: currentSize.
                menu add: styleName subMenu: subMenu.
                menu lastItem font: ((self named: styleName) fontOfSize: 18).
                styleName = currentTextStyle ifTrue: [menu lastItem color: Color blue darker]].

        menu popUpInWorld: self currentWorld! !


!TheWorldMenu methodsFor: 'commands' stamp: 'dgd 9/21/2003 17:43'!
cleanUpWorld
	(SelectionMenu confirm:
'This will remove all windows except those
containing unsubmitted text edits, and will
also remove all non-window morphs (other
than flaps) found on the desktop.  Are you
sure you want to do this?' translated)
		ifFalse: [^ self].

	myWorld allNonFlapRelatedSubmorphs do:
		[:m | m delete].
	(SystemWindow windowsIn: myWorld satisfying: [:w | w model canDiscardEdits])
		do: [:w | w delete]! !

!TheWorldMenu methodsFor: 'mechanics' stamp: 'dgd 8/26/2003 21:05'!
menu: titleString
	"Create a menu with the given title, ready for filling"

	| menu |
	(menu _ MenuMorph entitled: titleString translated) 
		defaultTarget: self; 
		addStayUpItem;
		commandKeyHandler: self.
	self colorForDebugging: menu.
	^ menu
! !

!TheWorldMenu methodsFor: 'windows & flaps menu' stamp: 'sw 7/22/2002 08:59'!
windowsMenu
        "Build the windows menu for the world."

        ^ self fillIn: (self menu: 'windows') from: {  
                { 'find window' . { #myWorld . #findWindow: }. 'Presents a list of all windows; if you choose one from the list, it becomes the active window.'}.

                { 'find changed browsers...' . { #myWorld . #findDirtyBrowsers: }. 'Presents a list of browsers that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.

                { 'find changed windows...' . { #myWorld . #findDirtyWindows: }. 'Presents a list of all windows that have unsubmitted changes; if you choose one from the list, it becomes the active window.'}.
			nil.

                { 'find a transcript (t)' . { #myWorld . #findATranscript: }. 'Brings an open Transcript to the front, creating one if necessary, and makes it the active window'}.

               { 'find a fileList (L)' . { #myWorld . #findAFileList: }. 'Brings an open fileList  to the front, creating one if necessary, and makes it the active window'}.

               { 'find a change sorter (C)' . { #myWorld . #findAChangeSorter: }. 'Brings an open change sorter to the front, creating one if necessary, and makes it the active window'}.

			{ 'find message names (W)' . { #myWorld . #findAMessageNamesWindow: }. 'Brings an open MessageNames window to the front, creating one if necessary, and makes it the active window'}.

			 nil.
                { #staggerPolicyString . { self . #toggleWindowPolicy }. 'stagger: new windows positioned so you can see a portion of each one.
                tile: new windows positioned so that they do not overlap others, if possible.'}.

                nil.
                { 'collapse all windows' . { #myWorld . #collapseAll }. 'Reduce all open windows to collapsed forms that only show titles.'}.
                { 'expand all windows' . { #myWorld . #expandAll }. 'Expand all collapsed windows back to their expanded forms.'}.
                { 'close top window (w)' . { SystemWindow . #closeTopWindow }. 'Close the topmost window if possible.'}.
                { 'send top window to back (\)' . { SystemWindow . #sendTopWindowToBack  }. 'Make the topmost window become the backmost one, and activate the window just beneath it.'}.
			 { 'move windows onscreen' . { #myWorld . #bringWindowsFullOnscreen }. 'Make all windows fully visible on the screen'}.

                nil.
                { 'delete unchanged windows' . { #myWorld . #closeUnchangedWindows }. 'Deletes all windows that do not have unsaved text edits.'}.
                { 'delete non-windows' . { #myWorld . #deleteNonWindows }. 'Deletes all non-window morphs lying on the world.'}.
                { 'delete both of the above' . { self . #cleanUpWorld }. 'deletes all unchanged windows and also all non-window morphs lying on the world, other than flaps.'}.

        }! !


!Time methodsFor: 'converting' stamp: 'BP 5/17/2000 00:00'!
asSeconds
	"Answer the number of seconds since midnight of the receiver."

	^seconds! !


!Time class methodsFor: 'general inquiries' stamp: 'tk 8/30/2000 21:46'!
condenseBunches: aCollectionOfSeconds
	| secArray pause now out prev bunchEnd ago |
	"Identify the major intervals in a bunch of numbers.  Each number is a seconds since 1901 that represents a date and time.  We want the last event in a bunch.  Return array of seconds for:
	Every event in the last half hour.
	Every bunch separated by 30 min in the last 24 hours.
	Every bunch separated by two hours before that."
"Time condenseBunches: 
	(#(20 400 401  20000 20200 20300   40000 45000  200000 201000 202000) collect: [:tt | 
		self totalSeconds - tt]) 
"
	secArray _ aCollectionOfSeconds asSortedCollection.
	pause _ 1.
	now _ self totalSeconds.
	out _ OrderedCollection new.
	prev _ 0.
	bunchEnd _ nil.
	secArray reverseDo: [:secs | "descending"
		ago _ now - secs.
		ago > (60*30) ifTrue: [pause _ "60*30" 1800].
		ago > (60*60*24) ifTrue: [pause _ "60*120" 7200].
		ago - prev >= pause ifTrue: [out add: bunchEnd.  bunchEnd _ secs].
		prev _ ago].
	out add: bunchEnd.
	out removeFirst.
	^ out! !

!Time class methodsFor: 'general inquiries' stamp: 'mir 10/29/1999 18:27'!
milliseconds: currentTime since: lastTime
	| delta |
	"Answer the elapsed time since last recorded in milliseconds.
	Compensate for rollover."

	delta _ currentTime - lastTime.
	^delta < 0
		ifTrue: [SmallInteger maxVal + delta]
		ifFalse: [delta]
! !

!Time class methodsFor: 'general inquiries'!
millisecondsToRun: timedBlock 
	"Answer the number of milliseconds timedBlock takes to return its value."

	| initialMilliseconds |
	initialMilliseconds _ self millisecondClockValue.
	timedBlock value.
	^self millisecondClockValue - initialMilliseconds! !

!Time class methodsFor: 'general inquiries'!
totalSeconds
	"Answer the total seconds from January 1, 1901."

	^ self primSecondsClock! !


!TimeStamp methodsFor: 'converting' stamp: 'ccn 10/6/2000 23:33'!
asTimeStamp
	"Answer the receiver as an instance of TimeStamp."

	^self! !

!TimeStamp methodsFor: 'converting' stamp: 'ccn 10/6/2000 23:34'!
dateAndTime
	"Answer a two element Array containing the receiver's date and time."

	^Array with: self date with: self time! !


!TranscriptStream methodsFor: 'initialization' stamp: 'di 5/27/1998 16:36'!
openAsMorphLabel: labelString 
	"Build a morph viewing this transcriptStream"
	| window |
	window _ (SystemWindow labelled: labelString) model: self.
	window addMorph: (PluggableTextMorph on: self text: nil accept: nil
			readSelection: nil menu: #codePaneMenu:shifted:)
		frame: (0@0 corner: 1@1).
	^ window! !


!UpdatingStringMorph methodsFor: 'accessing'!
target: anObject

	target _ anObject.
! !


!Utilities class methodsFor: 'miscellaneous' stamp: 'ar 1/31/2001 17:06'!
addSampleWindowsTo: aPage
	"Add windows representing a browser, a workspace, etc., to aPage"
	|  aWindow pu |
	aWindow _ Browser new openAsMorphEditing: nil.
	aWindow setLabel: 'System Browser'.
	aPage addMorphBack: aWindow applyModelExtent.
	aWindow _ PackagePaneBrowser new openAsMorphEditing: nil.
	aWindow setLabel: 'Package Browser'.
	aPage addMorphBack: aWindow applyModelExtent.
	aWindow _ Workspace new embeddedInMorphicWindowLabeled: 'Workspace'.
	aPage addMorphBack: aWindow applyModelExtent.
	aPage addMorphBack: FileList openAsMorph applyModelExtent.

	aPage addMorphBack: DualChangeSorter new morphicWindow applyModelExtent.
	aPage addMorphBack: ChangeSorter new morphicWindow applyModelExtent.

	aWindow _ SelectorBrowser new morphicWindow.
	aWindow setLabel: 'Selector Browser'.
	aPage addMorphBack: aWindow.
	aPage addMorphBack: ((pu _ PasteUpMorph newSticky borderInset) embeddedInMorphicWindowLabeled: 'assembly').
	pu color: (Color r: 0.839 g: 1.0 b: 0.935)! !

!Utilities class methodsFor: 'miscellaneous' stamp: 'sw 6/8/2001 00:25'!
methodDiffFor: aString class: aClass selector: aSelector prettyDiffs: prettyDiffBoolean.
	"Return a string comprising a source-code diff between an existing method and the source-code in aString.  DO prettyDiff if prettyDiffBoolean is true."

	^ (aClass notNil and: [aClass includesSelector: aSelector])
		ifTrue:
			[TextDiffBuilder
				buildDisplayPatchFrom: (aClass sourceCodeAt: aSelector)
				to: aString
				inClass: aClass
				prettyDiffs: prettyDiffBoolean]
		ifFalse:
			[aString copy]! !


!WaveletCodec methodsFor: 'subclass responsibilities' stamp: 'ar 3/17/2001 23:44'!
encodeFrames: frameCount from: srcSoundBuffer at: srcIndex into: dstByteArray at: dstIndex
	"Encode the given number of frames starting at the given index in the given monophonic SoundBuffer and storing the encoded sound data into the given ByteArray starting at the given destination index. Encode only as many complete frames as will fit into the destination. Answer a pair containing the number of samples consumed and the number of bytes of compressed data produced."
	"Note: Assume that the sender has ensured that the given number of frames will not exhaust either the source or destination buffers."

	| frameBase coeffs maxVal minVal c scale nullCount frameI outFrameSize threshold sm outStream cMin val |
	threshold _ 2000.
	fwt ifNil:
		[samplesPerFrame _ self samplesPerFrame.
		nLevels _ 8.
		"Here are some sample mother wavelets, with the compression achieved on a
		sample of my voice at a threshold of 2000:
									compression achieved "
		alpha _ 0.0.  beta _ 0.0.		"12.1"
		alpha _ 1.72.  beta _ 1.51.	"14.0"
		alpha _ -1.86.  beta _ -1.53.	"14.4"
		alpha _ 1.28.  beta _ -0.86.	"15.9"
		alpha _ -1.15.  beta _ 0.69.	"16.0"
		fwt _ FWT new.
		fwt nSamples: samplesPerFrame nLevels: nLevels.
		fwt setAlpha: alpha beta: beta].

	(outStream _ WriteStream on: dstByteArray from: dstIndex to: dstByteArray size)
		nextNumber: 4 put: frameCount;
		nextNumber: 4 put: samplesPerFrame;
		nextNumber: 4 put: nLevels;
		nextNumber: 4 put: alpha asIEEE32BitWord;
		nextNumber: 4 put: beta asIEEE32BitWord.
	frameBase _ srcIndex.
	1 to: frameCount do:
		[:frame | 

		"Copy float values into the wavelet sample array"		
		fwt samples: ((frameBase to: frameBase + samplesPerFrame-1) 
				collect: [:i | (srcSoundBuffer at: i) asFloat]).

		"Compute the transform"
		fwt transformForward: true.

		frameI _ outStream position+1.  "Reserve space for frame size"
		outStream nextNumber: 2 put: 0.

		"Determine and output the scale for this frame"
		coeffs _ fwt coeffs.
		maxVal _ 0.0.  minVal _ 0.0.
		5 to: coeffs size do:
			[:i | c _ coeffs at: i.
			c > maxVal ifTrue: [maxVal _ c].
			c < minVal ifTrue: [minVal _ c]].
		scale _ (maxVal max: minVal negated) / 16000.0.  "Will scale all to -16k..16k: 15 bits"
		outStream nextNumber: 4 put: scale asIEEE32BitWord.

		"Copy scaled values, with run-coded sequences of 0's, to destByteArray"
		nullCount _ 0.
		cMin _ threshold / scale.
		5 to: coeffs size do:
			[:i | c _ (coeffs at: i) / scale.
			c abs < cMin
			ifTrue: ["Below threshold -- count nulls."
					nullCount _ nullCount + 1]
			ifFalse: ["Above threshold -- emit prior null count and this sample."
					nullCount > 0 ifTrue:
						[nullCount <= 112
						ifTrue: [outStream nextNumber: 1 put: nullCount-1]
						ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1].
						nullCount _ 0].
						val _ c asInteger + 16384 + 32768.  "Map -16k..16k into 32k..64k"
						outStream nextNumber: 2 put: val]].

					nullCount > 0 ifTrue:
						[nullCount <= 112
						ifTrue: [outStream nextNumber: 1 put: nullCount-1]
						ifFalse: [outStream nextNumber: 2 put: (112*256) + nullCount-1]].
		outFrameSize _ outStream position+1 - frameI - 2.  "Write frame size back at the beginning"
		(WriteStream on: dstByteArray from: frameI to: dstByteArray size)
			nextNumber: 2 put: outFrameSize.
		frameBase _ frameBase + samplesPerFrame].

"This displays a temporary indication of compression achieved"
sm _ TextMorph new contents: (((frameBase - srcIndex) *2.0 / (outStream position+1 - dstIndex) truncateTo: 0.1) printString , ' : 1') asText allBold.
sm position: Sensor cursorPoint + (-20@30).
ActiveWorld addMorph: sm.
World doOneCycleNow.
sm delete.

	outStream position > dstByteArray size ifTrue:
		["The calling routine only provides buffer space for compression of 2:1 or better.  If you are just testing things, you can increase it to, eg, codeFrameSize _ frameSize*3, which would be sufficient for a threshold of 0 (lossless conversion)."
		self error: 'Buffer overrun'].

	^ Array with: frameBase - srcIndex
			with: outStream position+1 - dstIndex! !


!WeakRegistry methodsFor: 'accessing' stamp: 'ar 3/21/98 16:33'!
size
	^self protected:[
		valueDictionary size
	].! !


!WorldState methodsFor: 'update cycle' stamp: 'ar 10/26/2000 14:12'!
doDeferredUpdatingFor: aWorld
        "If this platform supports deferred updates, then make my canvas be the Display (or a rectangular portion of it), set the Display to deferred update mode, and answer true. Otherwise, do nothing and answer false. One can set the class variable DisableDeferredUpdates to true to completely disable the deferred updating feature."
	| properDisplay |
	PasteUpMorph disableDeferredUpdates ifTrue: [^ false].
	(Display deferUpdates: true) ifNil: [^ false].  "deferred updates not supported"
	remoteServer ifNotNil:[
		self assuredCanvas.
		^true].
	properDisplay _ canvas notNil and: [canvas form == Display].
	aWorld == World ifTrue: [  "this world fills the entire Display"
		properDisplay ifFalse: [
			aWorld viewBox: Display boundingBox.    "do first since it may clear canvas"
			self canvas: (Display getCanvas copyClipRect: Display boundingBox).
		]
	] ifFalse: [  "this world is inside an MVC window"
		(properDisplay and: [canvas clipRect = aWorld viewBox]) ifFalse: [
			self canvas:
				(Display getCanvas copyOffset: 0@0 clipRect: aWorld viewBox)
		]
	].
	^ true
! !


!ZipEncoderTree methodsFor: 'private' stamp: 'ar 12/30/1999 14:26'!
setValuesFrom: nodeList
	self bitLengths: (nodeList collect:[:n| n bitLength] from: 1 to: maxCode+1)
		codes: (nodeList collect:[:n| n code] from: 1 to: maxCode+1).! !

Browser initialize!
ImageMorph initialize!
Morph initialize!
