'From Cuis 1.0 of 21 May 2009 [latest update: #204] on 28 May 2009 at 12:52:35 pm'!
!classDefinition: #Morph category: #'Morphic-OldKernel'!
Object subclass: #Morph
	instanceVariableNames: 'bounds owner submorphs fullBounds color extension layoutInset hResizing vResizing '
	classVariableNames: 'EmptyArray '
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!

!CodeHolder methodsFor: 'annotation' stamp: 'jmv 5/28/2009 00:46'!
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.
	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! !


!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2009 00:08'!
buildMorphicSwitches
	| instanceSwitch commentSwitch classSwitch row aColor |
	instanceSwitch := PluggableButtonMorph 
				on: self
				getState: #instanceMessagesIndicated
				action: #indicateInstanceMessages.
	instanceSwitch
		label: 'instance';
		askBeforeChanging: true;
		borderWidth: 0.
	commentSwitch := PluggableButtonMorph 
				on: self
				getState: #classCommentIndicated
				action: #plusButtonHit.
	commentSwitch
		label: '?' asText allBold;
		askBeforeChanging: true;
		setBalloonText: 'class comment';
		borderWidth: 0.
	classSwitch := PluggableButtonMorph 
				on: self
				getState: #classMessagesIndicated
				action: #indicateClassMessages.
	classSwitch
		label: 'class';
		askBeforeChanging: true;
		borderWidth: 0.
	row _ AlignmentMorph proportional.
	row
		addInRow: {instanceSwitch. commentSwitch. classSwitch}
		atFractions: #(0.0 0.5 0.65 1.0)
		inset: 1@0.
	aColor := Color colorFrom: self class windowColor.
	row color: aColor duller.	"ensure matching button divider color. (see #paneColor)"
	Preferences alternativeWindowLook ifTrue: [aColor := aColor muchLighter].
	{ 
		instanceSwitch.
		commentSwitch.
		classSwitch} do: 
				[:m | 
				m
					color: aColor;
					onColor: aColor twiceDarker offColor: aColor].
	^row! !


!ChangeList methodsFor: 'menu actions' stamp: 'jmv 5/28/2009 00:08'!
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;
			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! !


!CompiledMethod methodsFor: 'testing' stamp: 'jmv 5/23/2009 00:47'!
hasReportableSlip
	"Answer whether the receiver contains anything that should be brought to the attention of the author when filing out.   Customize the lists here to suit your preferences.  If slips do not get reported in spite of your best efforts here, make certain that the Preference 'checkForSlips' is set to true."

	| assoc | 
	#(doOnlyOnce: halt halt: hottest printDirectlyToDisplay toRemove urgent) do:
		[:aLit | (self hasLiteral: aLit) ifTrue: [^ true]].

	#(Transcript AA BB CC DD EE) do:
		[:aSymbol | (assoc _ (Smalltalk associationAt: aSymbol ifAbsent: [nil])) ifNotNil:
			[(self hasLiteral: assoc) ifTrue: [^ true]]].

	^ false! !


!Debugger methodsFor: 'initialize' stamp: 'jmv 5/28/2009 00:09'!
customButtonRow
	"Answer a button pane affording the user one-touch access to certain functions; the pane is given the formal name 'customButtonPane' by which it can be retrieved by code wishing to send messages to widgets residing on the pane"

	| aButton aLabel buttons row |
	buttons _ OrderedCollection new.
	self customButtonSpecs do: [ :tuple | 
		aButton := PluggableButtonMorph 
					on: self
					getState: nil
					action: tuple second.
		aButton
			clipSubmorphs: true;
			onColor: Color transparent offColor: Color transparent.
		(#(#proceed #restart #send #doStep #stepIntoBlock #fullStack #where) 
			includes: tuple second) ifTrue: [aButton askBeforeChanging: true].
		aLabel := Preferences abbreviatedBrowserButtons 
					ifTrue: [self abbreviatedWordingFor: tuple second]
					ifFalse: [nil].
		aButton label: (aLabel ifNil: [tuple first asString]).
		tuple size > 2 ifTrue: [aButton setBalloonText: tuple third].
		Preferences alternativeWindowLook ifTrue: [
			aButton
				borderWidth: 2;
				borderColor: #raised].
		buttons add: aButton].
		
	row _ AlignmentMorph proportional.
	row addInProportionalRow: buttons.
	^row! !


!FileList class methodsFor: 'instance creation' stamp: 'jmv 5/28/2009 00:08'!
addVolumesAndPatternPanesTo: window at: upperFraction plus: offset forFileList: aFileList 
	| column patternHeight volumeListMorph patternMorph divider dividerDelta |
	column _ AlignmentMorph proportional.
	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 new.
	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].
	column
		addMorph: (volumeListMorph autoDeselect: false)
		fullFrame: (LayoutFrame
				fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ patternHeight negated - dividerDelta)).
	column
		addMorph: divider
		fullFrame: (LayoutFrame
				fractions: (0 @ 1 corner: 1 @ 1)
				offsets: (0 @ patternHeight negated - dividerDelta corner: 0 @ patternHeight negated)).
	column
		addMorph: patternMorph
		fullFrame: (LayoutFrame
				fractions: (0 @ 1 corner: 1 @ 1)
				offsets: (0 @ patternHeight negated 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]! !


!FileList2 class methodsFor: 'morphic ui' stamp: 'jmv 5/22/2009 23:47'!
morphicViewFileSelectorForSuffixes: aList 
	"Answer a morphic file-selector tool for the given suffix list"

	| dir aFileList window fixedSize midLine gap |
	dir := FileDirectory default.
	aFileList := self new directory: dir.
	aFileList optionalButtonSpecs: aFileList okayAndCancelServices.
	aList ifNotNil: 
			[aFileList 
				fileSelectionBlock: 
					[:entry :myPattern | 
					entry isDirectory 
						ifTrue: [false]
						ifFalse: 
							[aList includes: (FileDirectory extensionFor: entry name asLowercase)]] 
							fixTemps].
	window := AlignmentMorph proportional
				color: Color lightBlue;
				borderColor: Color blue;
				extent: 600 @ 400.
	window setProperty: #fileListModel toValue: aFileList.
	aFileList modalView: window.
	midLine := 0.4.
	fixedSize := 25.
	gap := 5.
	self addFullPanesTo: window
		from: {
				{ 
					self textRow: 'Please select a file' translated.
					0 @ 0 corner: 1 @ 0.
					0 @ 4 corner: 0 @ fixedSize}.
				{ 
					aFileList optionalButtonRow.
					0 @ 0 corner: 1 @ 0.
					0 @ fixedSize corner: 0 @ (fixedSize * 2)}.
				{ 
					aFileList morphicDirectoryTreePane.
					0 @ 0 corner: midLine @ 1.
					gap @ (fixedSize * 2) corner: gap negated @ 0}.
				{ 
					aFileList morphicFileListPane.
					midLine @ 0 corner: 1 @ 1.
					gap @ (fixedSize * 2) corner: gap negated @ 0}}.
	aFileList postOpen.
	^window! !


!LayoutFrame methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:52'!
fractions: fractionsOrNil offsets: offsetsOrNil

	| fractions offsets |

	fractions _ fractionsOrNil ifNil: [0@0 extent: 0@0].
	topFraction _ fractions top.
	leftFraction _ fractions left.
	bottomFraction _ fractions bottom.
	rightFraction _ fractions right.

	offsets _ offsetsOrNil ifNil: [0].
	offsets isNumber
		ifTrue: [
			leftOffset _ topOffset _ offsets.
			rightOffset _ bottomOffset _ offsets negated ]
		ifFalse: [
			offsets isPoint
				ifTrue: [
					leftOffset _ offsets x.
					rightOffset _ offsets x negated.
					topOffset _ offsets y.
					bottomOffset _ offsets y negated  ]
				ifFalse: [
					leftOffset _ offsets left.
					rightOffset _ offsets right.
					topOffset _ offsets top.
					bottomOffset _ offsets bottom ]]! !


!LayoutFrame class methodsFor: 'as yet unclassified' stamp: 'jmv 5/28/2009 00:53'!
fractions: fractionsOrNil offsets: offsetsOrNil

	^self new fractions: fractionsOrNil offsets: offsetsOrNil! !


!MessageNames methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:09'!
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 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! !


!Morph methodsFor: 'copying' stamp: 'jmv 5/28/2009 00:18'!
veryDeepInner: deepCopier 
	"The inner loop, so it can be overridden when a field should not  
	be traced."
	"super veryDeepInner: deepCopier.	know Object has no inst vars"
	bounds _ bounds clone.
	"Points are shared with original"
	"owner _ owner.	special, see veryDeepFixupWith:"
	submorphs _ submorphs veryDeepCopyWith: deepCopier.
	"each submorph's fixup will install me as the owner"
	"fullBounds _ fullBounds.	fullBounds is shared with original!!"
	color _ color veryDeepCopyWith: deepCopier.
	"color, if simple, will return self. may be complex"
	extension _ extension.
	self
		privateExtension: (self extension veryDeepCopyWith: deepCopier)! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 5/23/2009 00:23'!
balloonColor
	^ self defaultBalloonColor! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 5/23/2009 00:24'!
balloonFont
	^ self defaultBalloonFont! !

!Morph methodsFor: 'layout' stamp: 'jmv 5/22/2009 23:38'!
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

	"Note: Testing for #bounds or #layoutBounds would be sufficient to
	figure out if we need an invalidation afterwards but #bounds
	is what we need for all leaf nodes so we use that."

	| box priorBounds |
	priorBounds := self bounds.
	submorphs isEmpty ifTrue: [^fullBounds := priorBounds].
	"Send #ownerChanged to our children"
	submorphs do: [:m | m ownerChanged].
	self submorphsDo: [ :m | m layoutProportionallyIn: layoutBounds].

	fullBounds := self privateFullBounds.
	box := self bounds.
	box = priorBounds 
		ifFalse: [self invalidRect: (priorBounds quickMerge: box)]! !

!Morph methodsFor: 'layout' stamp: 'jmv 5/22/2009 23:51'!
layoutBounds
	"Return the bounds for laying out children of the receiver"
	^self innerBounds! !

!Morph methodsFor: 'layout' stamp: 'jmv 5/22/2009 23:32'!
layoutChanged
	fullBounds ifNil:[^self]. "layout will be recomputed so don't bother"
	fullBounds _ nil.
	owner ifNotNil: [owner layoutChanged].
	"note: does not send #ownerChanged here - we'll do this when computing the new layout"! !

!Morph methodsFor: 'layout' stamp: 'jmv 5/28/2009 00:28'!
layoutInBounds: cellBounds
	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
	| box delta |
	fullBounds ifNil:["We are getting new bounds here but we haven't computed the receiver's layout yet. Although the receiver has reported its minimal size before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
		
		self flag: #jmvRemove.
		"Leer el comentario. Entender. Simplificar!! (no hay mas shrinkWrap!!)"
		
		cellBounds origin = self bounds origin ifFalse:[
			box _ self bounds.
			delta _ cellBounds origin - self bounds origin.
			self invalidRect: (box merge: (box translateBy: delta)).
			self privateFullMoveBy: delta]. "sigh..."
		"Compute inset of layout bounds"
		box _ box origin - (self bounds origin - self layoutBounds origin) corner:
					box corner - (self bounds corner - self layoutBounds corner).
		"And do the layout within the new bounds"
		self layoutBounds: box.
		self doLayoutIn: box].
	cellBounds = self fullBounds ifTrue:[^self]. "already up to date"
	cellBounds extent = self fullBounds extent "nice fit"
		ifTrue:[^self position: cellBounds origin].
	box _ bounds.
	"match #spaceFill constraints"
	box _ box origin extent: cellBounds width @ cellBounds height.
	"align accordingly"
	box _ box align: box center with: cellBounds center.
	"and install new bounds"
	self bounds: box.! !

!Morph methodsFor: 'submorphs-add/remove' stamp: 'jmv 5/28/2009 00:30'!
addMorph: aMorph fullFrame: aLayoutFrame

	aMorph layoutFrame: aLayoutFrame.
	self addMorph: aMorph.

! !


!AlignmentMorph methodsFor: 'initialization' stamp: 'jmv 5/22/2009 23:50'!
initialize
	"initialize the state of the receiver"
	super initialize.

	self
		extent: 1@1;
		borderWidth: 0;
		clipSubmorphs: true! !


!BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'jmv 5/28/2009 00:07'!
forBottomEdge
	^self new resizingEdge: #bottom! !

!BorderedSubpaneDividerMorph class methodsFor: 'as yet unclassified' stamp: 'jmv 5/28/2009 00:07'!
forTopEdge
	^self new resizingEdge: #top! !


!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:48'!
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.4;
		bottomFraction: 0.98.
	result layoutFrame: frame.
	self addMorph: result.
	^result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:48'!
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.6;
		bottomFraction: 0.98.
	result layoutFrame: frame.
	self addMorph: result.
	^result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:38'!
createQueryTextMorph: queryString 
	"create the queryTextMorph"
	| result frame |
	result := TextMorph new contents: queryString.
	result lock.
	frame := LayoutFrame new.
	frame topFraction: 0.02.
	frame leftFraction: 0.05.
	result layoutFrame: frame.
	self addMorph: result.
	^ result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:42'!
createTextPaneExtent: answerExtent acceptBoolean: acceptBoolean
	"create the textPane"
	| result frame |
	result := PluggableTextMorph
				on: self
				text: #response
				accept: #response:
				readSelection: #selectionInterval
				menu: #codePaneMenu:shifted:.
	result extent: answerExtent.
	result borderWidth: 1.
	result hasUnacceptedEdits: true.
	result acceptOnCR: acceptBoolean.
	frame := LayoutFrame new.
	frame leftFraction: 0.0;
		 rightFraction: 1.0;
		 topFraction: 0.2;
		 bottomFraction: 0.7.
	result layoutFrame: frame.
	self addMorph: result.
	^ result! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/22/2009 23:48'!
setDefaultParameters
	"change the receiver's appareance parameters"
	| colorFromMenu worldColor menuColor menuBorderColor |
	colorFromMenu := Preferences menuColorFromWorld
				and: [Display depth > 4]
				and: [(worldColor := self currentWorld color) isColor].
	menuColor := colorFromMenu
				ifTrue: [worldColor luminance > 0.7
						ifTrue: [worldColor mixed: 0.85 with: Color black]
						ifFalse: [worldColor mixed: 0.4 with: Color white]]
				ifFalse: [Preferences menuColor].
	menuBorderColor := Preferences menuAppearance3d
				ifTrue: [#raised]
				ifFalse: [colorFromMenu
						ifTrue: [worldColor muchDarker]
						ifFalse: [Preferences menuBorderColor]].
	self
		setColor: menuColor
		borderWidth: Preferences menuBorderWidth
		borderColor: menuBorderColor! !

!FillInTheBlankMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:43'!
setQuery: queryString initialAnswer: initialAnswer answerExtent: answerExtent acceptOnCR: acceptBoolean 
	| query topOffset accept cancel buttonAreaHeight |
	response := initialAnswer.
	done := false.
	self removeAllMorphs.
	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.
	self extent: (query extent x max: answerExtent x)
			+ 4 @ (topOffset + answerExtent y + 4 + buttonAreaHeight).
	! !


!HaloMorph methodsFor: 'private' stamp: 'jmv 5/23/2009 00:50'!
doRecolor: evt with: aHandle
	"The mouse went down in the 'recolor' halo handle.  Allow the user to change the color of the innerTarget"

	evt hand obtainHalo: self.
	(aHandle containsPoint: evt cursorPoint)
		ifFalse:  "only do it if mouse still in handle on mouse up"
			[self delete.
			target addHalo: evt]
		ifTrue:
			[innerTarget changeColor]! !


!MenuMorph methodsFor: 'copying' stamp: 'jmv 5/22/2009 23:29'!
veryDeepInner: deepCopier
	"Copy all of my instance variables.  Some need to be not copied at all, but shared.  	Warning!!!!  Every instance variable defined in this class must be handled.  We must also implement veryDeepFixupWith:.  See DeepCopier class comment."

super veryDeepInner: deepCopier.
"defaultTarget _ defaultTarget.		Weakly copied"
selectedItem _ selectedItem veryDeepCopyWith: deepCopier.
stayUp _ stayUp veryDeepCopyWith: deepCopier.
popUpOwner _ popUpOwner.		"Weakly copied"
activeSubMenu _ activeSubMenu. "Weakly copied"
titleMorph _ deepCopier references at: titleMorph ifAbsent: [titleMorph].! !

!MenuMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2009 00:16'!
setDefaultParameters
	| colorFromMenu worldColor menuColor menuBorderColor |
	colorFromMenu := Preferences menuColorFromWorld
				and: [Display depth > 4]
				and: [(worldColor := self currentWorld color) isColor].
	""
	menuColor := colorFromMenu
				ifTrue: [worldColor luminance > 0.7
						ifTrue: [worldColor mixed: 0.85 with: Color black]
						ifFalse: [worldColor mixed: 0.4 with: Color white]]
				ifFalse: [Preferences menuColor].
	""
	menuBorderColor := Preferences menuAppearance3d
				ifTrue: [#raised]
				ifFalse: [colorFromMenu
						ifTrue: [worldColor muchDarker]
						ifFalse: [Preferences menuBorderColor]].
	""
	self
		setColor: menuColor
		borderWidth: Preferences menuBorderWidth
		borderColor: menuBorderColor! !


!PluggableButtonMorph class methodsFor: 'example' stamp: 'jmv 5/28/2009 00:09'!
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'.

	row _ AlignmentMorph proportional
		addInRow: (Array with: b1 with: b2 with: b3);
		extent: 120@35.
	^ row
! !


!PolygonMorph methodsFor: 'halo control' stamp: 'jmv 5/23/2009 00:28'!
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]! !

!PolygonMorph methodsFor: 'halo control' stamp: 'jmv 5/23/2009 00:28'!
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.! !


!Preferences class methodsFor: 'misc' stamp: 'jmv 5/23/2009 00:48'!
cleanUp
	| dict |
	dict _ DictionaryOfPreferences.
	
	(dict keys select: [ :each |
	(((dict at: each) instVarNamed: 'changeInformee') isKindOf: Behavior) and: [
		((dict at: each) instVarNamed: 'changeInformee') isObsolete ]]) do: [ :eachKey |
			dict removeKey: eachKey ].
		
	(dict keys select: [:each | (Smalltalk allCallsOn: each) isEmpty]) do: [ :eachKey |
			dict removeKey: eachKey ]! !

!Preferences class methodsFor: 'misc' stamp: 'jmv 5/23/2009 00:50'!
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)
		(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/23/2009 00:50'!
brightSqueak
	"The classic bright Squeak look.  Windows have saturated colors and relatively low contrast; scroll-bars are of the flop-out variety and are on the left.  Many power-user features are enabled."

	self setPreferencesFrom:
	#(
		(alternativeWindowLook false)
		(annotationPanes true)
		(automaticFlapLayout true)
		(balloonHelpEnabled true)
		(browseWithPrettyPrint false)
		(browserShowsPackagePane false)
		(classicNewMorphMenu false)
		(cmdDotEnabled true)
		(collapseWindowsInPlace false)
		(colorWhenPrettyPrinting false)
		(debugHaloHandle true)
		(debugPrintSpaceLog false)
		(debugShowDamage false)
		(decorateBrowserButtons true)
		(diffsInChangeList true)
		(diffsWithPrettyPrint false)
		(fastDragWindowForMorphic true)
		(fullScreenLeavesDeskMargins true)
		(hiddenScrollBars false)
		(ignoreStyleIfOnlyBold true)
		(inboardScrollbars false)
		(logDebuggerStackToFile true)
		(menuButtonInToolPane false)
		(menuColorFromWorld false)
		(menuKeyboardControl true)
		(optionalButtons true)
		(personalizedWorldMenu true)
		(restartAlsoProceeds false)
		(reverseWindowStagger true)
		(scrollBarsNarrow false)
		(scrollBarsWithoutMenuButton false)
		(selectiveHalos false)
		(simpleMenus false)
		(smartUpdating true)
		(systemWindowEmbedOK false)
		(thoroughSenders true)
		(warnIfNoChangesFile true)
		(warnIfNoSourcesFile true))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 5/23/2009 00:50'!
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)
		(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))! !

!Preferences class methodsFor: 'themes' stamp: 'jmv 5/23/2009 00:50'!
westwood
	"Settings generally similar to those found in a standard browser-plug-in-based Squeak image"

	self setPreferencesFrom: #(
		(alternativeWindowLook true)
		(honorDesktopCmdKeys false)
		(menuKeyboardControl false)
		)! !


!SimpleServiceEntry methodsFor: 'performing service' stamp: 'jmv 5/28/2009 00:09'!
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;
		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! !


!SketchMorph methodsFor: 'drawing' stamp: 'jmv 5/23/2009 00:03'!
drawOn: aCanvas
	aCanvas translucentImage: originalForm at: bounds origin
! !

!SketchMorph methodsFor: 'geometry' stamp: 'jmv 5/23/2009 00:08'!
extent: newExtent
	"Change my scale to fit myself into the given extent."
	self extent = newExtent ifTrue:[^self].
	self layoutChanged.
! !

!SketchMorph methodsFor: 'geometry testing' stamp: 'jmv 5/23/2009 00:03'!
containsPoint: aPoint

	^ (self bounds containsPoint: aPoint) and:
	  [(originalForm isTransparentAt: aPoint - bounds origin) not]
! !

!SketchMorph methodsFor: 'initialization' stamp: 'jmv 5/23/2009 00:09'!
initializeWith: aForm

	super initialize.
	originalForm _ aForm.
	self extent: originalForm extent.
! !

!SketchMorph methodsFor: 'layout' stamp: 'jmv 5/23/2009 00:05'!
layoutChanged
	"Update rotatedForm and compute new bounds."
	self changed.
	bounds _ bounds origin extent: originalForm extent.
	super layoutChanged.
	self changed.
! !


!SystemWindow methodsFor: 'initialization' stamp: 'jmv 5/22/2009 23:42'!
initialize
	"Initialize a system window. Add label, stripes, etc., if desired"
	super initialize.
	labelString ifNil: [labelString := 'Untitled Window' translated].
	isCollapsed := false.
	paneMorphs := Array new.
	Preferences alternativeWindowLook 
		ifTrue: [
			borderColor := #raised.
			borderWidth := 2.
			color := Color white]
		ifFalse: [
			borderColor := Color black.
			borderWidth := 1.
			color := Color black].
	
	self wantsLabel ifTrue: [self initializeLabelArea].
	self 
		on: #mouseEnter
		send: #spawnReframeHandle:
		to: self.
	self 
		on: #mouseLeave
		send: #spawnReframeHandle:
		to: self.
	self extent: 300 @ 200.
	updatablePanes := Array new! !


!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:09'!
buildFilterButton
	| filterButton |
	filterButton := PluggableButtonMorph 
				on: self
				getState: nil
				action: #setFilter
				label: #filterButtonLabel.
	filterButton onColor: self runButtonColor offColor: self runButtonColor.
	^filterButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:09'!
buildRefreshButton
	| refreshButton |
	refreshButton := PluggableButtonMorph 
				on: self
				getState: #refreshButtonState
				action: #refreshTests
				label: #refreshButtonLabel.
	refreshButton
		color: self runButtonColor.
	refreshButton onColor: self runButtonColor offColor: self runButtonColor.
	^refreshButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:10'!
buildRunButton
	| runButton |
	runButton := PluggableButtonMorph 
				on: self
				getState: #runButtonState
				action: #runTests
				label: #runButtonLabel.
	runButton
		color: self runButtonColor.
	runButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^runButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:10'!
buildRunOneButton
	| runOneButton |
	runOneButton := PluggableButtonMorph 
				on: self
				getState: #runButtonState
				action: #runOneTest
				label: #runOneButtonLabel.
	runOneButton
		color: self runButtonColor.
	runOneButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^runOneButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:10'!
buildStopButton
	| stopButton |
	stopButton := PluggableButtonMorph 
				on: self
				getState: #stopButtonState
				action: #terminateRun
				label: #stopButtonLabel.
	stopButton
		color: self runButtonColor.
	stopButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^stopButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2009 00:10'!
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
				 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: 'jmv 5/28/2009 00:10'!
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.
	win
		addMorph: progress 
		frame: (0.0 @ 0.7 extent: 1.0 @ 0.3).
! !

ThreePhaseButtonMorph class removeSelector: #radioButton!
ThreePhaseButtonMorph removeSelector: #authorModeOwner:!
ThreePhaseButtonMorph removeSelector: #dragIfAuthoring:!
ThreePhaseButtonMorph removeSelector: #pressedImage!
SketchMorph class removeSelector: #fromFile:!
SketchMorph class removeSelector: #fromStream:!
ColorPickerMorph removeSelector: #deleteOnMouseUp!
ColorPickerMorph removeSelector: #deleteOnMouseUp:!
ColorPickerMorph removeSelector: #selectedColor!
ColorPickerMorph removeSelector: #updateContinuously!
SketchMorph removeSelector: #addBorderToShape:!
SketchMorph removeSelector: #addCustomMenuItems:hand:!
SketchMorph removeSelector: #canDrawAtHigherResolution!
SketchMorph removeSelector: #erasePixelsOfColor:!
SketchMorph removeSelector: #forwardDirection:!
SketchMorph removeSelector: #framesToDwell!
SketchMorph removeSelector: #framesToDwell:!
SketchMorph removeSelector: #generateRotatedForm!
SketchMorph removeSelector: #newForm:!
SketchMorph removeSelector: #nominalForm:!
SketchMorph removeSelector: #originalForm:!
SketchMorph removeSelector: #recolorPixelsOfColor:!
SketchMorph removeSelector: #reduceColorPalette:!
SketchMorph removeSelector: #releaseCachedState!
SketchMorph removeSelector: #revealPenStrokes!
SketchMorph removeSelector: #rotatedForm!
SketchMorph removeSelector: #rotationStyle!
SketchMorph removeSelector: #rotationStyle:!
SketchMorph removeSelector: #scaleFactor!
SketchMorph removeSelector: #scalePoint!
SketchMorph removeSelector: #scalePoint:!
SketchMorph removeSelector: #setNewFormFrom:!
SketchMorph removeSelector: #setRotationStyle!
Preferences class removeSelector: #acceptAnnotationsFrom:!
Preferences class removeSelector: #alternativeWindowBoxesLook!
Preferences class removeSelector: #browseThemes!
Preferences class removeSelector: #categoriesContainingPreference:!
Preferences class removeSelector: #chooseFontWithPrompt:andSendTo:withSelector:!
Preferences class removeSelector: #classicNavigatorEnabled!
Preferences class removeSelector: #defaultAnnotationRequests:!
Preferences class removeSelector: #defaultPaintingExtent!
Preferences class removeSelector: #desktopColor!
Preferences class removeSelector: #desktopColor:!
Preferences class removeSelector: #disableGently:!
Preferences class removeSelector: #enableGently:!
Preferences class removeSelector: #enableOrDisable:asPer:!
Preferences class removeSelector: #expungeParameter:!
Preferences class removeSelector: #fontFactor!
Preferences class removeSelector: #giveHelpWithPreferences!
Preferences class removeSelector: #haloTheme!
Preferences class removeSelector: #installTheme:!
Preferences class removeSelector: #listOfCategories!
Preferences class removeSelector: #loadPreferencesFrom:!
Preferences class removeSelector: #metaMenuDisabled!
Preferences class removeSelector: #offerThemesMenu!
Preferences class removeSelector: #parameterAt:!
Preferences class removeSelector: #parameterAt:default:!
Preferences class removeSelector: #personal!
Preferences class removeSelector: #preferenceObjectsInCategory:!
Preferences class removeSelector: #presentMvcFontConfigurationMenu!
Preferences class removeSelector: #preserveCommandExcursions!
Preferences class removeSelector: #propertySheetFromHalo!
Preferences class removeSelector: #restorePersonalPreferences!
Preferences class removeSelector: #restorePreferencesFromDisk!
Preferences class removeSelector: #savePersonalPreferences!
Preferences class removeSelector: #scrollBarColor!
Preferences class removeSelector: #showChooseGraphicHaloHandle!
Preferences class removeSelector: #standaloneSecurityChecksEnabled!
Preferences class removeSelector: #storePreferencesIn:!
Preferences class removeSelector: #storePreferencesToDisk!
Preferences class removeSelector: #suppressWindowTitlesInInstanceBrowsers!
Preferences class removeSelector: #textHighlightColor:!
Preferences class removeSelector: #themeChoiceButtonOfColor:font:!
Preferences class removeSelector: #useCategoryListsInViewers!
Preferences class removeSelector: #windowColorHelp!
Preferences class removeSelector: #windowTitleStyle!
PluggableTextMorph removeSelector: #toggleAnnotationPaneSize!
MorphExtension removeSelector: #layoutPolicy!
MorphExtension removeSelector: #layoutPolicy:!
MenuItemMorph removeSelector: #hResizing!
ImageMorph class removeSelector: #defaultForm!
ImageMorph removeSelector: #image!
ImageMorph removeSelector: #newForm:!
ImageMorph removeSelector: #releaseCachedState!
ImageMorph removeSelector: #setNewImageFrom:!
HaloMorph removeSelector: #setDirection:with:!
FillInTheBlankMorph removeSelector: #createTextPaneExtent:acceptBoolean:topOffset:buttonAreaHeight:!
BorderedSubpaneDividerMorph class removeSelector: #horizontal!
BorderedSubpaneDividerMorph class removeSelector: #vertical!
BorderedSubpaneDividerMorph removeSelector: #horizontal!
BorderedSubpaneDividerMorph removeSelector: #vertical!
Morph removeSelector: #addPaintingItemsTo:hand:!
Morph removeSelector: #balloonColor:!
Morph removeSelector: #balloonFont:!
Morph removeSelector: #canDrawAtHigherResolution!
Morph removeSelector: #defaultValueOrNil!
Morph removeSelector: #forwardDirection!
Morph removeSelector: #forwardDirection:!
Morph removeSelector: #hResizing!
Morph removeSelector: #hResizing:!
Morph removeSelector: #heading!
Morph removeSelector: #layoutInset!
Morph removeSelector: #layoutInset:!
Morph removeSelector: #layoutPolicy!
Morph removeSelector: #layoutPolicy:!
Morph removeSelector: #rememberedColor!
Morph removeSelector: #rememberedColor:!
Morph removeSelector: #resetForwardDirection!
Morph removeSelector: #rotationStyle!
Morph removeSelector: #rotationStyle:!
Morph removeSelector: #scaleFactor!
Morph removeSelector: #setDirectionFrom:!
Morph removeSelector: #vResizing!
Morph removeSelector: #vResizing:!
Morph removeSelector: #wrappedInWindow:!
Morph removeSelector: #wrappedInWindowWithTitle:!
!classDefinition: #Morph category: #'Morphic-OldKernel'!
Object subclass: #Morph
	instanceVariableNames: 'bounds owner submorphs fullBounds color extension'
	classVariableNames: 'EmptyArray'
	poolDictionaries: ''
	category: 'Morphic-OldKernel'!
LayoutFrame class removeSelector: #offsets:!
LayoutFrame removeSelector: #bottomFraction:offset:!
LayoutFrame removeSelector: #leftFraction!
LayoutFrame removeSelector: #leftFraction:offset:!
LayoutFrame removeSelector: #leftOffset:!
LayoutFrame removeSelector: #minExtentFrom:!
LayoutFrame removeSelector: #negateBottomRightOffsets!
LayoutFrame removeSelector: #rightFraction!
LayoutFrame removeSelector: #rightFraction:offset:!
LayoutFrame removeSelector: #rightOffset:!
LayoutFrame removeSelector: #topFraction:offset:!
CodeHolder removeSelector: #annotationPaneMenu:shifted:!
Smalltalk removeClassNamed: #LayoutPolicy!
Smalltalk removeClassNamed: #ProportionalLayout!
