'From Cuis 1.0 of 19 April 2009 [latest update: #187] on 17 May 2009 at 11:42:20 am'!
!classDefinition: #MorphExtension category: #'Morphic-OldKernel'!
Object subclass: #MorphExtension
	instanceVariableNames: 'locked visible sticky balloonText externalName eventHandler otherProperties '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!

!Object methodsFor: 'viewer' stamp: 'jmv 5/15/2009 22:44'!
externalName
	"Answer an external name by which the receiver is known.  Generic implementation here is a transitional backstop. probably"

	self flag: #jmvRemove. "?"
	^ [(self asString copyWithout: Character cr) truncateTo:  27] ifError:
		[:msg :rcvr | ^ self class name printString]! !


!CodeHolder methodsFor: 'controls' stamp: 'jmv 5/16/2009 10:07'!
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: [self class windowColor duller paler]);
		borderWidth: 0.
	Preferences alternativeWindowLook ifTrue:[
		buttons submorphsDo:[ :m | m borderWidth: 1; 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: 'jmv 5/15/2009 22:38'!
buttonWithSelector: aSelector 
	"If receiver has a control button with the given action selector answer it, else answer nil.  morphic only at this point"

	| aWindow |
	((aWindow := self containingWindow) isSystemWindow) 
		ifFalse: [^nil].
	^aWindow 
		findDeepSubmorphThat: 
			[ :m | (m isKindOf: PluggableButtonMorph) and: [m actionSelector == aSelector]]
		ifAbsent: [ ^nil ]! !

!CodeHolder methodsFor: 'controls' stamp: 'jmv 5/16/2009 09:58'!
optionalButtonRow
	"Answer a row of control buttons"

	| row button aLabel buttons widths |
	buttons _ OrderedCollection new.
	widths _ OrderedCollection new.
	Preferences menuButtonInToolPane ifTrue: [
		buttons add: self menuButton.
		widths add: 4 ].
	self optionalButtonTuples do: [ :tuple | 
		widths add: tuple first.
		button _ PluggableButtonMorph 
					on: self
					getState: nil
					action: tuple third.
		button
			clipSubmorphs: true;
			onColor: Color transparent offColor: Color transparent.
		button borderWidth: 1.
		aLabel := Preferences abbreviatedBrowserButtons 
			ifTrue: [self abbreviatedWordingFor: tuple third]
			ifFalse: [nil].
		button label: (aLabel ifNil: [tuple second asString]).
		tuple size > 3 ifTrue: [button setBalloonText: tuple fourth].
		tuple size > 4 ifTrue: [button triggerOnMouseDown: tuple fifth].
		buttons add: button ].
	row _ AlignmentMorph proportional.
	row addInRow: buttons widthProportionalTo: widths inset: 2.
	^row! !


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 5/16/2009 09:58'!
optionalButtonRow
	"Answer a row of buttons to occur in a tool pane"

	| row button buttons widths |
	buttons _ OrderedCollection new.
	widths _ OrderedCollection new.
	self buttonSpecs do: [ :tuple | 
		widths add: tuple first.
		button _ PluggableButtonMorph 
					on: self
					getState: nil
					action: tuple third.
		button
			clipSubmorphs: true;
			hResizing: #spaceFill;
			vResizing: #spaceFill;
			label: tuple second asString;
			askBeforeChanging: true;
			onColor: Color transparent offColor: Color transparent.
		button borderWidth: 1.
		buttons add: button.
		button setBalloonText: tuple fourth].
	buttons add: self regularDiffButton.
	widths add: 9.
	self wantsPrettyDiffOption ifTrue: [
		buttons add:  self prettyDiffButton.
		widths add: 16 ].
	row _ AlignmentMorph proportional.
	row addInRow: buttons widthProportionalTo: widths inset: 2.
	^row! !


!Debugger methodsFor: 'controls' stamp: 'jmv 5/16/2009 10:01'!
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 | true])
		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: [self class windowColor duller paler]);
		borderWidth: 0.
	Preferences alternativeWindowLook ifTrue: [
		buttons submorphsDo:[:m | m borderWidth: 1; 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! !


!FileList class methodsFor: 'instance creation' stamp: 'jmv 5/16/2009 10:05'!
addButtonsAndFileListPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
	| fileListMorph column 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: 1;
								 borderColor: #raised].
						divider extent: 4 @ 4;
						 color: Color transparent;
						 borderColor: #raised;
						 borderWidth: 2.
					fileListMorph borderColor: Color transparent.
					dividerDelta _ 3].
			column _ AlignmentMorph proportional.
			buttonHeight _ self defaultButtonPaneHeight.
			column
				addMorph: buttons
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 0)
						offsets: (0 @ 0 corner: 0 @ buttonHeight)).
			column
				addMorph: divider
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 0)
						offsets: (0 @ buttonHeight corner: 0 @ buttonHeight + dividerDelta)).
			column
				addMorph: fileListMorph
				fullFrame: (LayoutFrame
						fractions: (0 @ 0 corner: 1 @ 1)
						offsets: (0 @ buttonHeight + dividerDelta corner: 0 @ 0)).
			window
				addMorph: column
				fullFrame: (LayoutFrame
						fractions: upperFraction
						offsets: (0 @ offset corner: 0 @ 0)).
			Preferences alternativeWindowLook
				ifTrue: [column borderWidth: 2]
				ifFalse: [column borderWidth: 0]]
		ifFalse: [
			fileListTop _ 0.
			window
				addMorph: fileListMorph
				frame: (0.3 @ fileListTop corner: 1 @ 0.3)].! !


!LightWidget methodsFor: 'copying' stamp: 'jmv 5/17/2009 11:30'!
copy

	^ self veryDeepCopy! !

!LightWidget methodsFor: 'copying' stamp: 'jmv 5/17/2009 11:30'!
duplicate
	"Make and return a duplicate of the receiver"

	| newMorph |
	newMorph _ self copy.
	newMorph privateOwner: nil. "no longer in world"

	^ newMorph! !


!MessageNames methodsFor: 'search' stamp: 'jmv 5/15/2009 22:31'!
searchString
	"Answer the current searchString"

	^ searchString! !

!MessageNames methodsFor: 'initialization' stamp: 'jmv 5/15/2009 22:04'!
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 proportional height: 14.

	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 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 addInProportionalRow: { searchButton. 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! !

!MessageNames methodsFor: 'initialization' stamp: 'jmv 5/15/2009 22:32'!
initialize
	super initialize.
	searchString _ 'type here, then hit Search'! !


!MethodFinder methodsFor: 'initialize' stamp: 'jmv 5/15/2009 22:32'!
initialize
	"The methods we are allowed to use.  (MethodFinder new initialize) "

	Approved _ Set new.
	AddAndRemove _ Set new.
	Blocks _ Set new.
	"These modify an argument and are not used by the MethodFinder: longPrintOn: printOn: storeOn: sentTo: storeOn:base: printOn:base: absPrintExactlyOn:base: absPrintOn:base: absPrintOn:base:digitCount: writeOn: writeScanOn: possibleVariablesFor:continuedFrom: printOn:format:"

"Object"  
	#("in class, instance creation" initialInstance  newFrom: readCarefullyFrom:
"accessing" at: basicAt: basicSize bindWithTemp: in: size yourself 
"testing" ifNil: ifNil:ifNotNil: ifNotNil: ifNotNil:ifNil: isColor isFloat isFraction isInMemory isInteger isMorph isNil isNumber isPoint isPseudoContext isText isTransparent isWebBrowser notNil pointsTo: wantsSteps 
"comparing" = == closeTo: hash hashMappedBy: identityHash identityHashMappedBy: identityHashPrintString ~= ~~ 
"copying" clone copy shallowCopy 
"dependents access" canDiscardEdits dependents hasUnacceptedEdits 
"updating" changed changed: okToChange update: windowIsClosing 
"printing" fullPrintString isLiteral longPrintString printString storeString stringForReadout stringRepresentation 
"class membership" class isKindOf: isKindOf:orOf: isMemberOf: respondsTo: xxxClass 
"error handling" 
"user interface" defaultLabelForInspector initialExtent modelWakeUp 
"system primitives" asOop instVarAt: instVarNamed: 
"private" 
"associating" -> 
"converting" as: asOrderedCollection asString 
"casing" caseOf: caseOf:otherwise: 
"binding" bindingOf: 
"macpal" contentsChanged currentEvent currentHand currentWorld flash ifKindOf:thenDo: instanceVariableValues 
"flagging" flag: 
"translation support" "objects from disk" "finalization" ) do: [:sel | Approved add: sel].
	#(at:add: at:modify: at:put: basicAt:put: "NOT instVar:at:"
"message handling" perform: perform:orSendTo: perform:with: perform:with:with: perform:with:with:with: perform:withArguments: perform:withArguments:inSuperclass: 
) do: [:sel | AddAndRemove add: sel].

"Boolean, True, False, UndefinedObject"  
	#("logical operations" & eqv: not xor: |
"controlling" and: ifFalse: ifFalse:ifTrue: ifTrue: ifTrue:ifFalse: or:
"copying" 
"testing" isEmptyOrNil) do: [:sel | Approved add: sel].

"Behavior" 
	#("initialize-release"
"accessing" compilerClass decompilerClass evaluatorClass format methodDict parserClass sourceCodeTemplate subclassDefinerClass
"testing" instSize instSpec isBits isBytes isFixed isPointers isVariable isWeak isWords
"copying"
"printing" printHierarchy
"creating class hierarchy"
"creating method dictionary"
"instance creation" basicNew basicNew: new new:
"accessing class hierarchy" allSubclasses allSubclassesWithLevelDo:startingLevel: allSuperclasses subclasses superclass withAllSubclasses withAllSuperclasses
"accessing method dictionary" allSelectors changeRecordsAt: compiledMethodAt: compiledMethodAt:ifAbsent: firstCommentAt: lookupSelector: selectors selectorsDo: selectorsWithArgs: "slow but useful ->" sourceCodeAt: sourceCodeAt:ifAbsent: sourceMethodAt: sourceMethodAt:ifAbsent:
"accessing instances and variables" allClassVarNames allInstVarNames allSharedPools classVarNames instVarNames instanceCount sharedPools someInstance subclassInstVarNames
"testing class hierarchy" inheritsFrom: kindOfSubclass
"testing method dictionary" canUnderstand: classThatUnderstands: hasMethods includesSelector: scopeHas:ifTrue: whichClassIncludesSelector: whichSelectorsAccess: whichSelectorsReferTo: whichSelectorsReferTo:special:byte: whichSelectorsStoreInto:
"enumerating"
"user interface"
"private" indexIfCompact) do: [:sel | Approved add: sel].

"ClassDescription"
	#("initialize-release" 
"accessing" classVersion isMeta name theNonMetaClass
"copying" 
"printing" classVariablesString instanceVariablesString sharedPoolsString
"instance variables" checkForInstVarsOK: 
"method dictionary" 
"organization" category organization whichCategoryIncludesSelector:
"compiling" acceptsLoggingOfCompilation wantsChangeSetLogging
"fileIn/Out" definition
"private" ) do: [:sel | Approved add: sel].

"Class"
	#("initialize-release" 
"accessing" classPool
"testing"
"copying" 
"class name" 
"instance variables" 
"class variables" classVarAt: classVariableAssociationAt:
"pool variables" 
"compiling" 
"subclass creation" 
"fileIn/Out" ) do: [:sel | Approved add: sel]. 

"Metaclass"
	#("initialize-release" 
"accessing" soleInstance
"copying" "instance creation" "instance variables"  "pool variables" "class hierarchy"  "compiling"
"fileIn/Out"  nonTrivial ) do: [:sel | Approved add: sel].

"Context, BlockContext"
	#(receiver client method receiver tempAt: 
"debugger access" mclass pc selector sender shortStack sourceCode tempNames tempsAndValues
"controlling"  "printing" "system simulation" 
"initialize-release" 
"accessing" hasMethodReturn home numArgs
"evaluating" value value:ifError: value:value: value:value:value: value:value:value:value: valueWithArguments:
"controlling"  "scheduling"  "instruction decoding"  "printing" "private"  "system simulation" ) do: [:sel | Approved add: sel].
	#(value: "<- Association has it as a store" ) do: [:sel | AddAndRemove add: sel].

"Message"
	#("inclass, instance creation" selector: selector:argument: selector:arguments:
"accessing" argument argument: arguments sends:
"printing" "sending" ) do: [:sel | Approved add: sel].
	#("private" setSelector:arguments:) do: [:sel | AddAndRemove add: sel].

"Magnitude"
	#("comparing" < <= > >= between:and:
"testing" max: min: min:max: ) do: [:sel | Approved add: sel].

"Date, Time"
	#("in class, instance creation" fromDays: fromSeconds: fromString: newDay:month:year: newDay:year: today
	"in class, general inquiries" dateAndTimeNow dayOfWeek: daysInMonth:forYear: daysInYear: firstWeekdayOfMonth:year: indexOfMonth: leapYear: nameOfDay: nameOfMonth:
"accessing" day leap monthIndex monthName weekday year
"arithmetic" addDays: subtractDate: subtractDays:
"comparing"
"inquiries" dayOfMonth daysInMonth daysInYear daysLeftInYear firstDayOfMonth previous:
"converting" asSeconds
"printing" mmddyy mmddyyyy printFormat: 
"private" firstDayOfMonthIndex: weekdayIndex 
	"in class, instance creation" fromSeconds: now 
	"in class, general inquiries" dateAndTimeFromSeconds: dateAndTimeNow millisecondClockValue millisecondsToRun: totalSeconds
"accessing" hours minutes seconds
"arithmetic" addTime: subtractTime:
"comparing"
"printing" intervalString print24 
"converting") do: [:sel | Approved add: sel].
	#("private" hours: hours:minutes:seconds: day:year: 
		 ) do: [:sel | AddAndRemove add: sel].

"Number"
	#("in class" readFrom:base: 
"arithmetic" * + - / // \\ abs negated quo: reciprocal rem:
"mathematical functions" arcCos arcSin arcTan arcTan: cos exp floorLog: ln log log: raisedTo: raisedToInteger: sin sqrt squared tan
"truncation and round off" ceiling detentBy:atMultiplesOf:snap: floor roundTo: roundUpTo: rounded truncateTo: truncated
"comparing"
"testing" even isDivisibleBy: isInf isInfinite isNaN isZero negative odd positive sign strictlyPositive
"converting" @ asInteger asNumber asPoint asSmallAngleDegrees degreesToRadians radiansToDegrees
"intervals" to: to:by: 
"printing" printStringBase: storeStringBase: ) do: [:sel | Approved add: sel].

"Integer"
	#("in class" primesUpTo:
"testing" isPowerOfTwo
"arithmetic" alignedTo:
"comparing"
"truncation and round off" atRandom normalize
"enumerating" timesRepeat:
"mathematical functions" degreeCos degreeSin factorial gcd: lcm: take:
"bit manipulation" << >> allMask: anyMask: bitAnd: bitClear: bitInvert bitInvert32 bitOr: bitShift: bitXor: lowBit noMask:
"converting" asCharacter asColorOfDepth: asFloat asFraction asHexDigit
"printing" asStringWithCommas hex hex8 radix:
"system primitives" lastDigit replaceFrom:to:with:startingAt:
"private" "benchmarks" ) do: [:sel | Approved add: sel].

"SmallInteger, LargeNegativeInteger, LargePositiveInteger"
	#("arithmetic" "bit manipulation" highBit "testing" "comparing" "copying" "converting" "printing" 
"system primitives" digitAt: digitLength 
"private" fromString:radix: ) do: [:sel | Approved add: sel].
	#(digitAt:put: ) do: [:sel | AddAndRemove add: sel].

"Float"
	#("arithmetic"
"mathematical functions" reciprocalFloorLog: reciprocalLogBase2 timesTwoPower:
"comparing" "testing"
"truncation and round off" exponent fractionPart integerPart significand significandAsInteger
"converting" asApproximateFraction asIEEE32BitWord asTrueFraction
"copying") do: [:sel | Approved add: sel].

"Fraction, Random"
	#(denominator numerator reduced next nextValue) do: [:sel | Approved add: sel].
	#(setNumerator:denominator:) do: [:sel | AddAndRemove add: sel].

"Collection"
	#("accessing" anyOne
"testing" includes: includesAllOf: includesAnyOf: includesSubstringAnywhere: isEmpty isSequenceable occurrencesOf:
"enumerating" collect: collect:thenSelect: count: detect: detect:ifNone: detectMax: detectMin: detectSum: inject:into: reject: select: select:thenCollect:
"converting" asBag asCharacterSet asSet asSortedArray asSortedCollection asSortedCollection:
"printing"
"private" maxSize
"arithmetic"
"math functions" average max median min range sum) do: [:sel | Approved add: sel].
	#("adding" add: addAll: addIfNotPresent:
"removing" remove: remove:ifAbsent: removeAll: removeAllFoundIn: removeAllSuchThat: remove:ifAbsent:) do: [:sel | AddAndRemove add: sel].

"SequenceableCollection"
	#("comparing" hasEqualElements:
"accessing" allButFirst allButLast at:ifAbsent: atAll: atPin: atRandom: atWrap: fifth first fourth identityIndexOf: identityIndexOf:ifAbsent: indexOf: indexOf:ifAbsent: indexOf:startingAt:ifAbsent: indexOfSubCollection:startingAt: indexOfSubCollection:startingAt:ifAbsent: last second sixth third
"removing"
"copying" , copyAfterLast: copyAt:put: copyFrom:to: copyReplaceAll:with: copyReplaceFrom:to:with: copyUpTo: copyUpToLast: copyWith: copyWithout: copyWithoutAll: forceTo:paddingWith: shuffled sortBy:
"enumerating" collectWithIndex: findFirst: findLast: pairsCollect: with:collect: withIndexCollect: polynomialEval:
"converting" asArray asDictionary asFloatArray asIntegerArray asStringWithCr asWordArray reversed
"private" copyReplaceAll:with:asTokens: ) do: [:sel | Approved add: sel].
	#( swap:with:) do: [:sel | AddAndRemove add: sel].

"ArrayedCollection, Bag"
	#("private" defaultElement 
"sorting" isSorted
"accessing" cumulativeCounts sortedCounts sortedElements "testing" "adding" add:withOccurrences: "removing" "enumerating" 
	) do: [:sel | Approved add: sel].
	#( mergeSortFrom:to:by: sort sort: add: add:withOccurrences:
"private" setDictionary ) do: [:sel | AddAndRemove add: sel].

"Other messages that modify the receiver"
	#(atAll:put: atAll:putAll: atAllPut: atWrap:put: replaceAll:with: replaceFrom:to:with:  removeFirst removeLast) do: [:sel | AddAndRemove add: sel].

	self initialize2.

"
MethodFinder new initialize.
MethodFinder new organizationFiltered: Set
"
! !


!Morph methodsFor: 'copying' stamp: 'jmv 5/17/2009 11:26'!
duplicate
	"Make and return a duplicate of the receiver"

	| newMorph |
	self okayToDuplicate ifFalse: [^ self].
	newMorph _ self copy.

	newMorph arrangeToStartStepping.
	newMorph privateOwner: nil. "no longer in world"

	^ newMorph! !

!Morph methodsFor: 'copying' stamp: 'jmv 5/15/2009 22:01'!
duplicateMorphCollection: aCollection
	"Make and return a duplicate of the receiver"

	| newCollection |

	newCollection _ aCollection veryDeepCopy.
	newCollection do: [ :newMorph |
		newMorph arrangeToStartStepping.
		newMorph privateOwner: nil. "no longer in world"
	].

	^newCollection! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/15/2009 22:33'!
addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
	| menu |
	menu _ MenuMorph new defaultTarget: self.
	self potentialEmbeddingTargets reverseDo: [:m | 
		menu 
			add: 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: 'jmv 5/15/2009 22:33'!
inspectAt: aPoint event: evt
	| menu morphs target |
	menu _ CustomMenu new.
	morphs _ self morphsAt: aPoint.
	(morphs includes: self) ifFalse:[morphs _ morphs copyWith: self].
	morphs do: [:m | 
		menu 
			add: m class name asString
			action: m].
	target _ menu startUpWithCaption: ('inspect whom?
(deepest at top)').
	target ifNil:[^self].
	target inspectInMorphic: evt! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 5/15/2009 22:33'!
invokeMetaMenuAt: aPoint event: evt
	| menu morphs target |
	menu _ CustomMenu new.
	morphs _ self morphsAt: aPoint.
	(morphs includes: self) ifFalse:[morphs _ morphs copyWith: self].
	morphs size = 1 ifTrue:[morphs first invokeMetaMenu: evt].
	morphs do: [:m | 
		menu add: m class name asString action: m].
	target _ menu startUp.
	target ifNil:[^self].
	target invokeMetaMenu: evt! !

!Morph methodsFor: 'naming' stamp: 'jmv 5/15/2009 22:33'!
nameForFindWindowFeature
	"Answer the name to show in a list of windows-and-morphs to represent the receiver"

	^ self class name! !

!Morph methodsFor: 'printing' stamp: 'jmv 5/15/2009 22:34'!
printOn: aStream 

	super printOn: aStream.
	aStream nextPutAll: '('.
	aStream
		print: self identityHash;
		nextPutAll: ')'! !


!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/15/2009 22:03'!
createAcceptButton
	"create the [accept] button"

	| result frame |
	result := (SimpleButtonMorph new)
				target: self;
				color: Color lightGreen.
	result borderColor: (Preferences menuAppearance3d 
				ifTrue: [#raised]
				ifFalse: [result color twiceDarker]).
	result
		label: 'Accept(s)' translated;
		actionSelector: #accept.
	frame := LayoutFrame new.
	frame
		rightFraction: 0.5;
		rightOffset: -10;
		bottomFraction: 1.0;
		bottomOffset: -2.
	result layoutFrame: frame.
	self addMorph: result.
	^result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/15/2009 22:03'!
createCancelButton
	"create the [cancel] button"

	| result frame |
	result := (SimpleButtonMorph new)
				target: self;
				color: Color lightRed.
	result borderColor: (Preferences menuAppearance3d 
				ifTrue: [#raised]
				ifFalse: [result color twiceDarker]).
	result
		label: 'Cancel(l)' translated;
		actionSelector: #cancel.
	frame := LayoutFrame new.
	frame
		leftFraction: 0.5;
		leftOffset: 10;
		bottomFraction: 1.0;
		bottomOffset: -2.
	result layoutFrame: frame.
	self addMorph: result.
	^result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/15/2009 22:03'!
createQueryTextMorph: queryString 
	"create the queryTextMorph"
	| result frame |
	result := TextMorph new contents: queryString.
	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: 'jmv 5/15/2009 22:03'!
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.
	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! !


!HaloMorph methodsFor: 'private' stamp: 'jmv 5/15/2009 22:06'!
addHandlesForWorldHalos
	"Add handles for world halos, like the man said"

	| box w |
	w _ self world ifNil:[target world].
	self removeAllMorphs.  "remove old handles, if any"
	self bounds: target bounds.
	box _ w bounds insetBy: 9.
	target addWorldHandlesTo: self box: box.

	self addNameBeneath: (box insetBy: (0@0 corner: 0@10)) string: innerTarget externalName.
	growingOrRotating _ false.
	self layoutChanged.
	self changed.
! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 5/15/2009 22:06'!
addName
	"Add a name readout at the bottom of the halo."

	self addNameBeneath: self basicBox string: target externalName
! !


!HandMorph methodsFor: 'meta-actions' stamp: 'jmv 5/16/2009 10:19'!
copyToPasteBuffer: aMorph
	"Save this morph in the paste buffer. This is mostly useful for copying morphs between projects."
	aMorph ifNil:[^PasteBuffer _ nil].
	Cursor wait showWhile:[
		PasteBuffer _ aMorph copy.
		PasteBuffer privateOwner: nil].

! !

!HandMorph methodsFor: 'paste buffer' stamp: 'jmv 5/16/2009 10:19'!
objectToPaste
	"It may need to be sent #startRunning by the client"
	^ Cursor wait showWhile: [PasteBuffer copy]

	"PasteBuffer usableDuplicateIn: self world"
! !


!MenuItemMorph methodsFor: 'accessing' stamp: 'jmv 5/15/2009 21:58'!
subMenu: aMenuMorph
	subMenu _ aMenuMorph.
	self changed.
! !

!MenuItemMorph methodsFor: 'events' stamp: 'jmv 5/15/2009 21:48'!
activateSubmenu: evt
	"Activate our submenu; e.g., pass control to it"
	subMenu ifNil:[^false]. "not applicable"
	(subMenu fullContainsPoint: evt position) ifFalse:[^false].
	subMenu activate: evt.
	self removeAlarm: #deselectTimeOut:.
	^true! !

!MenuItemMorph methodsFor: 'events' stamp: 'jmv 5/15/2009 21:48'!
deselectTimeOut: evt
	"Deselect timout. Now really deselect"
	owner selectedItem == self ifTrue:[owner selectItem: nil event: evt].! !

!MenuItemMorph methodsFor: 'events' stamp: 'jmv 5/15/2009 21:49'!
mouseLeaveDragging: evt 
	"The mouse left the receiver. Do nothing if we're not in a 'valid menu transition', meaning that the current hand focus must be aimed at the owning menu."
	owner ifNil: [^self].
	evt hand mouseFocus == owner ifFalse: [^self].
	"If we have a submenu, make sure we've got some time to enter it before actually leaving the menu item"
	subMenu isNil 
		ifTrue: [owner selectItem: nil event: evt]
		ifFalse: [
			self 
				addAlarm: #deselectTimeOut:
				with: evt
				after: 500]! !

!MenuItemMorph methodsFor: 'selecting' stamp: 'jmv 5/15/2009 21:48'!
deselect: evt

	self isSelected: false.
	subMenu ifNotNil: [
		owner ifNotNil:[ owner activeSubmenu: nil ].
		self removeAlarm: #deselectTimeOut: ].! !


!MenuMorph methodsFor: 'control' stamp: 'jmv 5/15/2009 21:50'!
popUpNoKeyboard
	"Present this menu in the current World, *not* allowing keyboard input into the menu"
	^ self popUpAt: ActiveHand position forHand: ActiveHand in: ActiveWorld allowKeyboard: false! !


!MorphExtension methodsFor: 'accessing - other properties' stamp: 'jmv 5/15/2009 22:14'!
sortedPropertyNames
	"answer the receiver's property names in a sorted way"

	| props |
	props := WriteStream on: (Array new: 10).
	locked == true ifTrue: [props nextPut: #locked].
	visible == false ifTrue: [props nextPut: #visible].
	sticky == true ifTrue: [props nextPut: #sticky].
	balloonText isNil ifFalse: [props nextPut: #balloonText].
	eventHandler isNil ifFalse: [props nextPut: #eventHandler].
	self hasOtherProperties 
		ifTrue: [self otherProperties associationsDo: [:a | props nextPut: a key]].
	^props contents sort: [:s1 :s2 | s1 <= s2]! !

!MorphExtension methodsFor: 'copying' stamp: 'jmv 5/17/2009 11:34'!
veryDeepInner: deepCopier 
	"Copy all of my instance variables. Some need to be not copied at 
	all, but shared. This is special code for the dictionary. See  
	DeepCopier."

	super veryDeepInner: deepCopier.
	locked _ locked veryDeepCopyWith: deepCopier.
	visible _ visible veryDeepCopyWith: deepCopier.
	sticky _ sticky veryDeepCopyWith: deepCopier.
	balloonText _ balloonText veryDeepCopyWith: deepCopier.
	eventHandler _ eventHandler veryDeepCopyWith: deepCopier.
	otherProperties _ otherProperties.
	"has its own restrictions"
	self hasOtherProperties
		ifTrue: [
			self privateOtherProperties: self otherProperties copy.
			self
				privateOtherProperties: (self otherProperties veryDeepCopyWith: deepCopier).
			]! !

!MorphExtension methodsFor: 'other' stamp: 'jmv 5/15/2009 22:14'!
isDefault
	"Return true if the receiver is a default and can be omitted"
	locked == true
		ifTrue: [^ false].
	visible == false
		ifTrue: [^ false].
	sticky == true
		ifTrue: [^ false].
	balloonText isNil
		ifFalse: [^ false].
	eventHandler isNil
		ifFalse: [^ false].
	self hasOtherProperties
		ifTrue: [self otherProperties isEmpty
				ifFalse: [^ false]].
	^ true! !

!MorphExtension methodsFor: 'printing' stamp: 'jmv 5/15/2009 22:14'!
printOn: aStream 
	"Append to the argument, aStream, a sequence of characters that 
	identifies the receiver." 
	super printOn: aStream.
	aStream nextPutAll: ' ' , self identityHashPrintString.
	locked == true
		ifTrue: [aStream nextPutAll: ' [locked] '].
	visible == false
		ifTrue: [aStream nextPutAll: '[not visible] '].
	sticky == true
		ifTrue: [aStream nextPutAll: ' [sticky] '].
	balloonText
		ifNotNil: [aStream nextPutAll: ' [balloonText] '].
	eventHandler
		ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] '].
	(self hasOtherProperties not or: [ self otherProperties isEmpty ])
		ifTrue: [^ self].
	aStream nextPutAll: ' [other: '.
	self otherProperties
		keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')'].
	aStream nextPut: $]! !


!Preferences class methodsFor: 'misc' stamp: 'jmv 5/15/2009 22:07'!
defaultValueTableForCurrentRelease
	"Answer a table defining default values for all the preferences in the release.  Returns a list of (pref-symbol, boolean-symbol) pairs"

	^  #(
		(abbreviatedBrowserButtons false)
		(alternativeBrowseIt false)
		(alternativeWindowLook true)
		(annotationPanes false)
		(automaticFlapLayout true)
		(automaticPlatformSettings true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying false)
		(caseSensitiveFinds false)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(confirmFirstUseOfStyle true)
		(conversionMethodsAtFileOut false)
		(cpuWatcherEnabled false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance false)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars true)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl false)  
		(modalColorPickers true)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk false)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart false)
		(soundStopWhenDone false)
		(soundsEnabled true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))


"
Preferences defaultValueTableForCurrentRelease do:
	[:pair | (Preferences preferenceAt: pair first ifAbsent: [nil]) ifNotNilDo:
			[:pref | pref defaultValue: (pair last == #true)]].
Preferences chooseInitialSettings.
"! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 5/15/2009 22:07'!
paloAlto
	"Similar to the brightSqueak theme, but with a number of idiosyncratic personal settings.   Note that caseSensitiveFinds is true"


	self setPreferencesFrom:
	#(
		(abbreviatedBrowserButtons false)
		(accessOnlineModuleRepositories noOpinion)
		(alternativeBrowseIt noOpinion)
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(automaticPlatformSettings noOpinion)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(canRecordWhilePlaying noOpinion)
		(caseSensitiveFinds true)
		(changeSetVersionNumbers true)
		(checkForSlips true)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(confirmFirstUseOfStyle true)
		(conservativeModuleDeActivation noOpinion)
		(conversionMethodsAtFileOut true)
		(cpuWatcherEnabled noOpinion)
		(debugHaloHandle true)
		(debugPrintSpaceLog true)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(dismissAllOnOptionClose true)
		(duplicateControlAndAltKeys false)
		(extraDebuggerButtons true)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(higherPerformance noOpinion)
		(honorDesktopCmdKeys true)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)  
		(modalColorPickers true)
		(modularClassDefinitions noOpinion)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(projectsSentToDisk noOpinion)
		(propertySheetFromHalo false)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(showBoundsInHalo false)
		(simpleMenus false)
		(smartUpdating true)
		(soundQuickStart noOpinion)
		(soundsEnabled true)
		(soundStopWhenDone noOpinion)
		(strongModules noOpinion)
		(swapControlAndAltKeys noOpinion)
		(swapMouseButtons  noOpinion)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(twentyFourHourFileStamps false)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !


!SimpleServiceEntry methodsFor: 'performing service' stamp: 'jmv 5/16/2009 10:06'!
buttonToTriggerIn: aFileList 
	"Answer a button that will trigger the receiver service in a file list"

	| aButton |
	aButton := PluggableButtonMorph 
				on: self
				getState: nil
				action: #performServiceFor:.
	aButton arguments: { 
				aFileList}.
	aButton
		color: Color transparent;
		hResizing: #spaceFill;
		vResizing: #spaceFill;
		label: self buttonLabel;
		askBeforeChanging: true;
		onColor: Color transparent offColor: Color transparent.
	aButton borderWidth: 1.
	aButton color: aFileList class windowColor duller paler.
	aButton setBalloonText: self description.
	Preferences alternativeWindowLook 
		ifTrue: [
			aButton
				borderWidth: 1;
				borderColor: #raised].
	^aButton! !


!SystemWindow methodsFor: 'printing' stamp: 'jmv 5/17/2009 08:03'!
printOn: aStream 

	super printOn: aStream.
	aStream nextPutAll: '('.
	aStream
		print: labelString asString;
		nextPutAll: ')'! !


!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/16/2009 09:59'!
optionalButtonRow
	| row btn buttons widths |

	buttons _ OrderedCollection new.
	widths _ OrderedCollection new.
	self optionalButtonTuples do: [ :tuple | 
		widths add: tuple first.
		btn _ PluggableButtonMorph 
			on: self
			getState: nil
			action: tuple third.
		btn
			clipSubmorphs: true;
			onColor: Color transparent offColor: Color transparent;
			label: tuple second.
		btn borderWidth: 1.
		buttons add: btn].
	row _ AlignmentMorph proportional.
	row addInRow: buttons widthProportionalTo: widths inset: 2.
	^row! !


!TextMorph methodsFor: 'copying' stamp: 'jmv 5/17/2009 11:38'!
copy
	^ super copy text: text copy textStyle: textStyle copy 
		wrap: wrapFlag color: color! !

!TextMorph methodsFor: 'private' stamp: 'jmv 5/16/2009 14:28'!
text: t textStyle: s wrap: wrap color: c
	"Private -- for use only in morphic duplication"
	text _ t.
	textStyle _ s.
	wrapFlag _ wrap.
	color _ c.
	paragraph _ editor _ container _ nil! !

TextMorph removeSelector: #text:textStyle:wrap:color:predecessor:successor:!
Preferences class removeSelector: #uniqueNamesInHalos!
PasteUpMorph removeSelector: #nameForCopyIfAlreadyNamed:!
MorphExtension removeSelector: #copyWeakly!
MorphExtension removeSelector: #externalName!
MorphExtension removeSelector: #externalName:!
MorphExtension removeSelector: #veryDeepFixupWith:!
!classDefinition: #MorphExtension category: #'Morphic-OldKernel'!
Object subclass: #MorphExtension
	instanceVariableNames: 'locked visible sticky balloonText eventHandler otherProperties'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!
MenuMorph removeSelector: #deleteIfPopUp!
MenuMorph removeSelector: #popUpOwner!
MenuMorph removeSelector: #popUpOwner:!
MenuItemMorph removeSelector: #deselectItem!
Morph removeSelector: #assureExternalName!
Morph removeSelector: #knownName!
Morph removeSelector: #name:!
Morph removeSelector: #setNamePropertyTo:!
Morph removeSelector: #setNameTo:!
Morph removeSelector: #submorphNamed:!
Morph removeSelector: #submorphNamed:ifNone:!
Object removeSelector: #knownName!
