'From Cuis 1.0 of 26 March 2009 [latest update: #158] on 31 March 2009 at 8:44:40 am'!
Smalltalk renameClassNamed: #OldBorderStyle as: #BorderStyle!
Smalltalk renameClassNamed: #OldKeyboardBuffer as: #KeyboardBuffer!
Smalltalk renameClassNamed: #OldLayoutCell as: #LayoutCell!
Smalltalk renameClassNamed: #OldLayoutFrame as: #LayoutFrame!
Smalltalk renameClassNamed: #OldLayoutPolicy as: #LayoutPolicy!
Smalltalk renameClassNamed: #OldLayoutProperties as: #LayoutProperties!
Smalltalk renameClassNamed: #OldMorph as: #Morph!
Smalltalk renameClassNamed: #OldBorderedMorph as: #BorderedMorph!
Smalltalk renameClassNamed: #OldBorderedSubpaneDividerMorph as: #BorderedSubpaneDividerMorph!
Smalltalk renameClassNamed: #OldEllipseMorph as: #EllipseMorph!
Smalltalk renameClassNamed: #OldHaloMorph as: #HaloMorph!
Smalltalk renameClassNamed: #OldHandMorph as: #HandMorph!
Smalltalk renameClassNamed: #OldHandleMorph as: #HandleMorph!
Smalltalk renameClassNamed: #OldImageMorph as: #ImageMorph!
Smalltalk renameClassNamed: #OldLazyListMorph as: #LazyListMorph!
Smalltalk renameClassNamed: #OldMenuLineMorph as: #MenuLineMorph!
Smalltalk renameClassNamed: #OldMinimalStringMorph as: #MinimalStringMorph!
Smalltalk renameClassNamed: #OldMorphExtension as: #MorphExtension!
Smalltalk renameClassNamed: #OldMorphWithModel as: #MorphWithModel!
Smalltalk renameClassNamed: #OldMouseClickState as: #MouseClickState!
Smalltalk renameClassNamed: #OldNewHandleMorph as: #NewHandleMorph!
Smalltalk renameClassNamed: #OldOneLineEditorMorph as: #OneLineEditorMorph!
Smalltalk renameClassNamed: #OldPasteUpMorph as: #PasteUpMorph!
Smalltalk renameClassNamed: #OldPolygonMorph as: #PolygonMorph!
Smalltalk renameClassNamed: #OldBalloonMorph as: #BalloonMorph!
Smalltalk renameClassNamed: #OldCurveMorph as: #CurveMorph!
Smalltalk renameClassNamed: #OldLineMorph as: #LineMorph!
Smalltalk renameClassNamed: #OldProgressBarMorph as: #ProgressBarMorph!
Smalltalk renameClassNamed: #OldProportionalLayout as: #ProportionalLayout!
Smalltalk renameClassNamed: #OldRectangleMorph as: #RectangleMorph!
Smalltalk renameClassNamed: #OldAlignmentMorph as: #AlignmentMorph!
Smalltalk renameClassNamed: #OldFillInTheBlankMorph as: #FillInTheBlankMorph!
Smalltalk renameClassNamed: #OldGraphicalMenu as: #GraphicalMenu!
Smalltalk renameClassNamed: #OldGraphicalDictionaryMenu as: #GraphicalDictionaryMenu!
Smalltalk renameClassNamed: #OldMenuMorph as: #MenuMorph!
Smalltalk renameClassNamed: #OldMVCMenuMorph as: #MVCMenuMorph!
Smalltalk renameClassNamed: #OldPluggableButtonMorph as: #PluggableButtonMorph!
Smalltalk renameClassNamed: #OldProgressMorph as: #ProgressMorph!
Smalltalk renameClassNamed: #OldScrollPane as: #ScrollPane!
Smalltalk renameClassNamed: #OldPluggableListMorph as: #PluggableListMorph!
Smalltalk renameClassNamed: #OldPluggableListMorphByItem as: #PluggableListMorphByItem!
Smalltalk renameClassNamed: #OldPluggableListMorphOfMany as: #PluggableListMorphOfMany!
Smalltalk renameClassNamed: #OldPluggableMessageCategoryListMorph as: #PluggableMessageCategoryListMorph!
Smalltalk renameClassNamed: #OldPluggableTextMorph as: #PluggableTextMorph!
Smalltalk renameClassNamed: #OldAcceptableCleanTextMorph as: #AcceptableCleanTextMorph!
Smalltalk renameClassNamed: #OldBrowserCommentTextMorph as: #BrowserCommentTextMorph!
Smalltalk renameClassNamed: #OldSelectionMorph as: #SelectionMorph!
Smalltalk renameClassNamed: #OldSimpleBorder as: #SimpleBorder!
Smalltalk renameClassNamed: #OldInsetBorder as: #InsetBorder!
Smalltalk renameClassNamed: #OldRaisedBorder as: #RaisedBorder!
Smalltalk renameClassNamed: #OldSimpleButtonMorph as: #SimpleButtonMorph!
Smalltalk renameClassNamed: #OldIconicButton as: #IconicButton!
Smalltalk renameClassNamed: #OldSimpleHierarchicalListMorph as: #SimpleHierarchicalListMorph!
Smalltalk renameClassNamed: #OldSketchMorph as: #SketchMorph!
Smalltalk renameClassNamed: #OldColorPickerMorph as: #ColorPickerMorph!
Smalltalk renameClassNamed: #OldSlider as: #Slider!
Smalltalk renameClassNamed: #OldScrollBar as: #ScrollBar!
Smalltalk renameClassNamed: #OldSonogram as: #Sonogram!
Smalltalk renameClassNamed: #OldStarMorph as: #StarMorph!
Smalltalk renameClassNamed: #OldStringMorph as: #StringMorph!
Smalltalk renameClassNamed: #OldBorderedStringMorph as: #BorderedStringMorph!
Smalltalk renameClassNamed: #OldIndentingListItemMorph as: #IndentingListItemMorph!
Smalltalk renameClassNamed: #OldMenuItemMorph as: #MenuItemMorph!
Smalltalk renameClassNamed: #OldSystemWindow as: #SystemWindow!
Smalltalk renameClassNamed: #OldPreDebugWindow as: #PreDebugWindow!
Smalltalk renameClassNamed: #OldSystemWindowWithButton as: #SystemWindowWithButton!
Smalltalk renameClassNamed: #OldTableLayout as: #TableLayout!
Smalltalk renameClassNamed: #OldTableLayoutProperties as: #TableLayoutProperties!
Smalltalk renameClassNamed: #OldTextAnchor as: #TextAnchor!
Smalltalk renameClassNamed: #OldTextComposer as: #TextComposer!
Smalltalk renameClassNamed: #OldTextContainer as: #TextContainer!
Smalltalk renameClassNamed: #OldTextLine as: #TextLine!
Smalltalk renameClassNamed: #OldTextMorph as: #TextMorph!
Smalltalk renameClassNamed: #OldStringMorphEditor as: #StringMorphEditor!
Smalltalk renameClassNamed: #OldTextMorphForEditView as: #TextMorphForEditView!
Smalltalk renameClassNamed: #OldTheWorldMenu as: #TheWorldMenu!
Smalltalk renameClassNamed: #OldThreePhaseButtonMorph as: #ThreePhaseButtonMorph!
Smalltalk renameClassNamed: #OldTransformMorph as: #TransformMorph!
Smalltalk renameClassNamed: #OldUpdatingMenuItemMorph as: #UpdatingMenuItemMorph!
Smalltalk renameClassNamed: #OldUpdatingSimpleButtonMorph as: #UpdatingSimpleButtonMorph!
Smalltalk renameClassNamed: #OldUpdatingStringMorph as: #UpdatingStringMorph!
Smalltalk renameClassNamed: #OldNameStringInHalo as: #NameStringInHalo!
Smalltalk renameClassNamed: #OldUpdatingThreePhaseButtonMorph as: #UpdatingThreePhaseButtonMorph!
Smalltalk renameClassNamed: #OldWorldState as: #WorldState!
Smalltalk renameClassNamed: #OldWorldTest as: #WorldTest!

!BorderStyle class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:40'!
inset
	^InsetBorder new! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:40'!
raised
	^RaisedBorder new! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:40'!
simple
	"Answer a simple border style"

	^SimpleBorder new! !

!BorderStyle class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:40'!
width: aNumber color: aColor 
	^(SimpleBorder new)
		color: aColor;
		width: aNumber;
		yourself! !


!ChangeSetCategory methodsFor: 'services' stamp: 'jmv 3/27/2009 09:56'!
fillAggregateChangeSet
	"Create a change-set named Aggregate and pour into it all the changes in all the change-sets of the currently-selected category"

	| aggChangeSet |
	aggChangeSet := ChangeSorter assuredChangeSetNamed: #Aggregate.
	aggChangeSet clear.
	aggChangeSet 
		setPreambleToSay: '"Change Set:		Aggregate
Created at ' 
				, Time now printString , ' on ' 
				, Date today printString 
					, ' by combining all the changes in all the change sets in the category ' 
					, categoryName printString , '"'.
	(self elementsInOrder copyWithout: aggChangeSet) 
		do: [:aChangeSet | aggChangeSet assimilateAllChangesFoundIn: aChangeSet].
	SystemWindow wakeUpTopWindowUponStartup! !


!CompositionScanner methodsFor: 'scanning' stamp: 'jmv 1/15/2005 20:46'!
composeFrom: startIndex inRectangle: lineRectangle firstLine: firstLine leftSide: leftSide rightSide: rightSide 
	"Answer an instance of TextLineInterval that represents the next line in the paragraph."

	"Set up margins"

	| runLength done stopCondition |
	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]]! !


!Form methodsFor: 'converting' stamp: 'jmv 1/15/2005 20:23'!
asMorph
	^ImageMorph new image: self! !


!FormsAndHelpsRepository methodsFor: 'form dictionary' stamp: 'jmv 1/15/2005 20:35'!
inspectFormDictionary
	"ScriptingSystem inspectFormDictionary"

	GraphicalDictionaryMenu openOn: FormDictionary
		withLabel: 'Testing One Two Three'! !


!ImageSegment methodsFor: 'fileIn/Out' stamp: 'jmv 1/15/2005 20:24'!
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]! !


!Imports methodsFor: 'images' stamp: 'jmv 3/27/2009 09:56'!
viewImages
	"Open up a special Form inspector on the dictionary of graphical imports."

	"Imports default viewImages"

	imports size isZero 
		ifTrue: 
			[^self 
				inform: 'The ImageImports repository is currently empty,
so there is nothing to view at this time.  You can
use a file list to import graphics from external files
into Imports, and once you have done that,
you will find this command more interesting.'].
	GraphicalDictionaryMenu openOn: imports withLabel: 'Graphical Imports'! !


!LayoutProperties methodsFor: 'converting' stamp: 'jmv 1/15/2005 20:39'!
asTableLayoutProperties
	^(TableLayoutProperties new)
		hResizing: self hResizing;
		vResizing: self vResizing;
		disableTableLayout: self disableTableLayout;
		yourself! !


!LightWidget methodsFor: 'debug and other' stamp: 'jmv 3/23/2008 19:04'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'inspect model' translated
				target: self model
				action: #inspect].
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !

!LightWidget methodsFor: 'defaults' stamp: 'jmv 8/26/2008 10:18'!
borderStyleFor: aColor
	^BorderStyle raised width: 3; color: aColor! !

!LightWidget methodsFor: 'defaults' stamp: 'jmv 8/26/2008 10:18'!
borderStyleWith: aColor
	^BorderStyle raised width: 3; color: aColor! !

!LightWidget methodsFor: 'defaults' stamp: 'jmv 4/2/2008 13:34'!
pressedBorderStyleWith: aColor
	^BorderStyle simple width: 1; color: aColor muchDarker! !

!LightWidget methodsFor: 'halos and balloon help' stamp: 'jmv 3/23/2008 18:57'!
addHalo: evt 
	| halo prospectiveHaloClass |
	prospectiveHaloClass := Smalltalk at: self haloClass ifAbsent: [HaloMorph].
	halo := prospectiveHaloClass new bounds: self worldBoundsForHalo.
	halo popUpFor: self event: evt.
	^halo! !

!LightWidget methodsFor: 'user interface' stamp: 'jmv 11/10/2008 23:50'!
activateWindowAndSendTopToBack: aBoolean

	| w |
	(w _ self ownerThatIsA: SystemWindow) ifNotNil: [
		w isTopWindow ifFalse: [
			w activateAndSendTopToBack: aBoolean]].! !

!LightWidget methodsFor: 'view of a model or target' stamp: 'jmv 8/4/2008 17:32'!
safeModelChanged
	"The model changed is some way.
	This is usually the place to call #targetAspect to fetch the current value of the aspect from the
		model, and to store it in some Model Extension.
	We must update all Model Extension instance variables with values from the model (i.e. target)
		or with appropriate defaults.
	We must update ourselves and all subviews to reflect the model's new state
	This method could be called from a process that is not the UI process.
	Do the update in the UI process, in the inter-cycle pause."

	Processor activeProcess == ProjectX uiProcessX
		ifTrue: [ self modelChanged ]
		ifFalse: [
			WorldState addDeferredUIMessage:  [
				self modelChanged ]]! !


!EntryField2LW methodsFor: 'drawing' stamp: 'jmv 11/17/2008 16:28'!
characterIndexAtPoint: aPoint

	| line block |
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: font height baseline: font ascent.
		
	block _ (CharacterBlockScanner new text: contents asText textStyle: (TextStyle fontArray: {font}))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !

!EntryField2LW methodsFor: 'editing' stamp: 'jmv 11/17/2008 16:04'!
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 the editor to Morphic keyboard events"

	| oldEditor oldContents |
	self editor sensor: (KeyboardBuffer new startingEvent: evt).
	oldEditor := editor.
	oldContents := contents.
	interactionBlock value.
	oldContents == contents 
		ifTrue: 
			["this will not work if the paragraph changed"

			editor := oldEditor	"since it may have been changed while in block"].
	self changed! !


!MethodFinder class methodsFor: 'as yet unclassified' stamp: 'jmv 2/12/2008 19:07'!
methodFor: dataAndAnswers 
	"Return a Squeak expression that computes these answers. (This method 
	is called by the comment in the bottom pane of a MethodFinder. Do not 
	delete this method.)"
	| resultOC selFinder resultString |
	resultOC _ self new load: dataAndAnswers;
				 findMessage.
	resultString _ String
				streamContents: [:strm | resultOC
						do: [:exp | strm nextPut: $(;
								 nextPutAll: exp;
								 nextPut: $);
								 space]].
	selFinder _ (ActiveWorld
				submorphThat: [:mm | mm class == SystemWindow
						and: [mm model isKindOf: SelectorBrowser]]
				ifNone: [^ resultString]) model.
	selFinder searchResult: resultOC.
	^ resultString! !


!Model methodsFor: 'dependents' stamp: 'jmv 2/12/2008 20:04'!
containingWindow
	"Answer the window that holds the receiver.  The dependents technique is odious and may not be airtight, if multiple windows have the same model."

	^self dependents detect: 
			[:d | 
			(d isKindOf: SystemWindow) 
				and: [d model == self]]
		ifNone: [nil]! !


!CPUWatcher methodsFor: 'porcine capture' stamp: 'jmv 3/27/2009 09:56'!
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! !

!CPUWatcher methodsFor: 'porcine capture' stamp: 'jmv 2/12/2008 18:49'!
openWindowForSuspendedProcess: aProcess 
	WorldState 
				addDeferredUIMessage: [self openMorphicWindowForSuspendedProcess: aProcess]! !


!DualChangeSorter methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:16'!
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! !


!Morph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:40'!
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 
				ifTrue: 
					["default border?"

					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: 'jmv 1/15/2005 20:39'!
borderStyle
	^(self valueOfProperty: #borderStyle ifAbsent: [BorderStyle default]) 
		trackColorFrom: self! !

!Morph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:40'!
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: 'accessing - extension' stamp: 'jmv 1/15/2005 20:22'!
initializeExtension
	"private - initializes the receiver's extension"

	self privateExtension: MorphExtension new initialize! !

!Morph methodsFor: 'debug and other' stamp: 'jmv 2/12/2008 19:09'!
buildDebugMenu: aHand 
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	self isKnownFailing
		ifTrue: 
			[aMenu add: 'start drawing again' translated action: #resumeAfterDrawError.
			aMenu addLine].
	(self hasProperty: #errorOnStep) 
		ifTrue: 
			[aMenu add: 'start stepping again' translated action: #resumeAfterStepError.
			aMenu addLine].
	aMenu add: 'inspect morph' translated action: #inspectInMorphic:.
	aMenu add: 'inspect owner chain' translated action: #inspectOwnerChain.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'inspect model' translated
				target: self model
				action: #inspect].
	aMenu 
		add: 'explore morph' translated
		target: self
		selector: #explore.
	aMenu addLine.
	aMenu 
		add: 'browse morph class' translated
		target: self
		selector: #browseHierarchy.
	self isMorphicModel 
		ifTrue: 
			[aMenu 
				add: 'browse model class'
				target: self model
				selector: #browseHierarchy].
	aMenu addLine.
	aMenu
		add: 'control-menu...' translated
			target: self
			selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.
	^aMenu! !

!Morph methodsFor: 'e-toy support' stamp: 'jmv 1/15/2005 20:16'!
containingWindow
	"Answer a window or window-with-mvc that contains the receiver"

	^self ownerThatIsA: SystemWindow! !

!Morph methodsFor: 'e-toy support' stamp: 'jmv 11/6/2008 14:31'!
embeddedInMorphicWindowLabeled: labelString 
	| window |
	window := (SystemWindow labelled: labelString) model: nil.
	window setStripeColorsFrom: nil class windowColor.
	window addMorph: self frame: (0 @ 0 extent: 1 @ 1).
	^window! !

!Morph methodsFor: 'e-toy support' stamp: 'jmv 1/15/2005 20:16'!
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: 'geometry eToy' stamp: 'jmv 1/15/2005 20:03'!
transparentSpacerOfSize: aPoint 
	^(Morph new extent: aPoint) color: Color transparent! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
defaultBalloonColor
	^Display depth <= 2 
		ifTrue: [Color white]
		ifFalse: [BalloonMorph balloonColor]! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/15/2005 20:35'!
defaultBalloonFont
	^BalloonMorph balloonFont! !

!Morph methodsFor: 'halos and balloon help' stamp: 'jmv 1/15/2005 20:35'!
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: 'initialization' stamp: 'jmv 1/15/2005 20:35'!
inATwoWayScrollPane
	"Answer a two-way scroll pane that allows the user to scroll the receiver in either direction.  It will have permanent scroll bars unless you take some special action."

	| widget |
	widget := ScrollPane new.
	widget
		extent: (self width min: 300 max: 100) @ (self height min: 150 max: 100);
		borderWidth: 0.
	widget scroller addMorph: self.
	widget setScrollDeltas.
	widget color: self color darker darker.
	^widget! !

!Morph methodsFor: 'layout-menu' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:12'!
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: 'jmv 1/15/2005 20:12'!
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: 'jmv 1/15/2005 20:12'!
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: 'jmv 1/15/2005 20:12'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:35'!
addCopyItemsTo: aMenu 
	"Add copy-like items to the halo menu"

	| subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
	subMenu add: 'copy text' translated action: #clipText.
	aMenu add: 'copy & print...' translated subMenu: subMenu! !

!Morph methodsFor: 'menus' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 11/12/2006 22:13'!
addHaloActionsTo: aMenu 
	"Add items to aMenu representing actions requestable via halo"

	| subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu addTitle: self externalName.
	subMenu addStayUpItemSpecial.
	subMenu addLine.
	subMenu add: 'delete' translated action: #dismissViaHalo.
	subMenu 
		balloonTextForLastItem: 'Delete this object -- warning -- can be destructive!!' 
				translated.
	self maybeAddCollapseItemTo: subMenu.
	subMenu add: 'grab' translated action: #openInHand.
	subMenu 
		balloonTextForLastItem: 'Pick this object up -- warning, since this removes it from its container, it can have adverse effects.' 
				translated.
	subMenu addLine.
	subMenu add: 'resize' translated action: #resizeFromMenu.
	subMenu 
		balloonTextForLastItem: 'Change the size of this object' translated.
	subMenu add: 'duplicate' translated action: #maybeDuplicateMorph.
	subMenu balloonTextForLastItem: 'Hand me a copy of this object' translated.
	subMenu 
		add: 'set color' translated
		target: self
		action: #changeColor.
	subMenu 
		balloonTextForLastItem: 'Change the color of this object' translated.
	subMenu 
		add: 'inspect' translated
		target: self
		action: #inspect.
	subMenu 
		balloonTextForLastItem: 'Open an Inspector on this object' translated.
	aMenu add: 'halo actions...' translated subMenu: subMenu! !

!Morph methodsFor: 'menus' stamp: 'jmv 10/26/2006 22:38'!
addPaintingItemsTo: aMenu hand: aHandMorph 
	| subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu add: 'reset forward-direction' translated
		action: #resetForwardDirection.
	subMenu add: 'set rotation style' translated action: #setRotationStyle.
	subMenu add: 'erase pixels of color' translated
		action: #erasePixelsOfColor:.
	subMenu add: 'recolor pixels of color' translated
		action: #recolorPixelsOfColor:.
	subMenu add: 'reduce color palette' translated action: #reduceColorPalette:.
	subMenu add: 'add a border around this shape...' translated
		action: #addBorderToShape:.
	aMenu add: 'painting...' translated subMenu: subMenu! !

!Morph methodsFor: 'menus' stamp: 'jmv 1/15/2005 20:35'!
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: 'menus' stamp: 'jmv 11/12/2006 22:08'!
chooseNewGraphicCoexisting: aBoolean 
	"Allow the user to choose a different form for her form-based morph"

	| reasonableForms aGraphicalMenu myGraphic |
	reasonableForms _ Imports default images asSet asOrderedCollection.
	(reasonableForms includes: (myGraphic := self form)) 
		ifTrue: [reasonableForms remove: myGraphic].
	reasonableForms addFirst: myGraphic.
	aGraphicalMenu := GraphicalMenu new 
				initializeFor: self
				withForms: reasonableForms
				coexist: aBoolean.
	aBoolean 
		ifFalse: [
			self owner replaceSubmorph: self by: aGraphicalMenu]
		ifTrue: [self primaryHand attachMorph: aGraphicalMenu]! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 2/18/2007 22:17'!
buildMetaMenu: evt 
	"Build the morph menu. This menu has two sections. The first section contains commands that are handled by the hand; the second contains commands handled by the argument morph."

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu addStayUpItem.
	menu add: 'grab' translated action: #grabMorph:.
	menu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:.
	self maybeAddCollapseItemTo: menu.
	menu add: 'delete' translated action: #dismissMorph:.
	menu addLine.
	menu add: 'copy text' translated action: #clipText.
	menu addLine.
	menu add: 'go behind' translated action: #goBehind.
	menu add: 'add halo' translated action: #addHalo:.
	menu add: 'duplicate' translated action: #maybeDuplicateMorph:.
	self addEmbeddingMenuItemsTo: menu hand: evt hand.
	menu add: 'resize' translated action: #resizeMorph:.
	"Give the argument control over what should be done about fill styles"
	self addFillStyleMenuItems: menu hand: evt hand.
	self addLayoutMenuItems: menu hand: evt hand.
	menu 
		addUpdating: #hasClipSubmorphsString
		target: self
		selector: #changeClipSubmorphs
		argumentList: #().
	menu addLine.
	(self morphsAt: evt position) size > 1 
		ifTrue: 
			[menu 
				add: 'submorphs...' translated
				target: self
				selector: #invokeMetaMenuAt:event:
				argument: evt position].
	menu addLine.
	menu 
		add: 'inspect' translated
		selector: #inspectAt:event:
		argument: evt position.
	menu add: 'explore' translated action: #explore.
	menu add: 'browse hierarchy' translated action: #browseHierarchy.
	menu add: 'show actions' translated action: #showActions.
	menu addLine.
	self addDebuggingItemsTo: menu hand: evt hand.
	self addCustomMenuItems: menu hand: evt hand.
	^menu! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 1/15/2005 20:35'!
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' stamp: 'jmv 1/15/2005 20:12'!
resizeMorph: evt 
	| handle |
	handle := HandleMorph new 
				forEachPointDo: [:newPoint | self extent: newPoint - self bounds topLeft].
	evt hand attachMorph: handle.
	handle startStepping! !

!Morph methodsFor: 'meta-actions' stamp: 'jmv 1/15/2005 20:21'!
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: 'objects from disk' stamp: 'jmv 1/15/2005 20:03'!
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."

	"block my owner unless he is written out by someone else"

	| cntInstVars cntIndexedVars ti localInstVars |
	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: 'structure' stamp: 'jmv 1/15/2005 20:25'!
pasteUpMorph
	"Answer the closest containing morph that is a PasteUp morph"

	^self ownerThatIsA: PasteUpMorph! !

!Morph methodsFor: 'testing' stamp: 'jmv 1/15/2005 20:03'!
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: 'text-anchor' stamp: 'jmv 1/15/2005 20:35'!
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: 'user interface' stamp: 'jmv 11/10/2008 23:51'!
activateWindowAndSendTopToBack: aBoolean

	| w |
	(w _ self ownerThatIsA: SystemWindow) ifNotNil: [
		w isTopWindow ifFalse: [
			w activateAndSendTopToBack: aBoolean]].! !


!BorderedMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:39'!
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: 'accessing' stamp: 'jmv 1/15/2005 20:39'!
borderStyle: aBorderStyle 
	"Work around the borderWidth/borderColor pair"

	aBorderStyle = self borderStyle ifTrue: [^self].
	"secure against invalid border styles"
	(self canDrawBorder: aBorderStyle) 
		ifFalse: 
			["Replace the suggested border with a simple one"

			^self borderStyle: (BorderStyle width: aBorderStyle width
						color: (aBorderStyle trackColorFrom: self) color)].
	aBorderStyle width = self borderStyle width ifFalse: [self changed].
	(aBorderStyle isNil or: [aBorderStyle == BorderStyle default]) 
		ifTrue: 
			[self removeProperty: #borderStyle.
			borderWidth := 0.
			^self changed].
	self setProperty: #borderStyle toValue: aBorderStyle.
	borderWidth := aBorderStyle width.
	borderColor := aBorderStyle style == #simple 
				ifTrue: [aBorderStyle color]
				ifFalse: [aBorderStyle style].
	self changed! !

!BorderedMorph methodsFor: 'menu' stamp: 'jmv 1/15/2005 20:39'!
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! !

!BorderedMorph methodsFor: 'menu' stamp: 'jmv 3/27/2009 09:57'!
changeBorderWidth: evt 
	| handle origin aHand newWidth |
	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).
					newWidth := (newPoint - origin) r asInteger // 5.
					self borderWidth: newWidth]
				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 border width.
Click when done.'
		hand: evt hand.
	handle startStepping! !


!HaloMorph methodsFor: 'private' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 8/26/2008 13:07'!
addHandle: handleSpec on: eventName send: selector to: recipient 
	"Add a handle within the halo box as per the haloSpec, and set it up to respond to the given event by sending the given selector to the given recipient.  Return the handle."

	| handle aPoint iconName colorToUse |
	aPoint := self 
				positionIn: haloBox
				horizontalPlacement: handleSpec horizontalPlacement
				verticalPlacement: handleSpec verticalPlacement.
	handle := EllipseMorph 
				newBounds: (Rectangle center: aPoint extent: HandleSize asPoint)
				color: (colorToUse := Color colorFrom: handleSpec color).
	self addMorph: handle.
	(iconName := handleSpec iconSymbol) ifNotNil: 
			[| form |
			form := ScriptingSystem formAtKey: iconName.
			form ifNotNil: 
					[handle addMorphCentered: ((ImageMorph new)
								image: form;
								color: colorToUse makeForegroundColor;
								lock)]].
	handle 
		on: #mouseUp
		send: #endInteraction
		to: self.
	handle 
		on: eventName
		send: selector
		to: recipient.
	handle 
		setBalloonText: (target balloonHelpTextForHandle: handle) translated.
	^handle! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 1/15/2005 20:23'!
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! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 5/28/2006 23:33'!
addNameBeneath: outerRectangle string: aString 
	"Add a name display centered beneath the bottom of the outer rectangle. Return the handle."

	| nameMorph namePosition w |
	w := self world ifNil: [target world].
	nameMorph := NameStringInHalo contents: aString.
	nameMorph color: Color magenta.
	nameMorph
		target: innerTarget;
		putSelector: #tryToRenameTo:.
	namePosition := outerRectangle bottomCenter 
				- ((nameMorph width // 2) @ (self handleSize negated // 2 - 1)).
	nameMorph 
		position: (namePosition min: w viewBox bottomRight - nameMorph extent y + 2).
	self addMorph: nameMorph.
	^nameMorph! !

!HaloMorph methodsFor: 'private' stamp: 'jmv 1/15/2005 20:35'!
doDup: evt with: dupHandle 
	"Ask hand to duplicate my target."

	(target isKindOf: SelectionMorph) 
		ifTrue: 
			[^target 
				doDup: evt
				fromHalo: self
				handle: dupHandle].
	self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
	self setTarget: (target duplicateMorph: evt).
	evt hand grabMorph: target.
	self step.	"update position if necessary"
	evt hand addMouseListener: self	"Listen for the drop"! !


!HandMorph methodsFor: 'double click support' stamp: 'jmv 1/15/2005 20:22'!
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! !


!ImageMorph class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:24'!
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! !


!MorphWithModel methodsFor: 'compilation' stamp: 'jmv 1/15/2005 20:19'!
nameFor: aMorph 
	"Return the name of the slot containing the given morph or nil if that morph has not been named."

	| allNames start |
	allNames := self class allInstVarNames.
	start := MorphWithModel allInstVarNames size + 1.
	start to: allNames size
		do: [:i | (self instVarAt: i) == aMorph ifTrue: [^allNames at: i]].
	^nil! !


!MorphWithModel class methodsFor: 'compiling' stamp: 'jmv 1/15/2005 20:19'!
acceptsLoggingOfCompilation
	"Dont log sources for my automatically-generated subclasses.  Can easily switch this back when it comes to deal with Versions, etc."

	^self == MorphWithModel or: [name last isDigit not]! !

!MorphWithModel class methodsFor: 'compiling' stamp: 'jmv 2/10/2005 20:07'!
wantsChangeSetLogging
	"Log changes for MorphWithModel itself and for things like PlayWithMe2, but not for automatically-created subclasses like MorphWithModel1, MorphWithModel2, etc."

	^ self == MorphWithModel or:
		[(self class name beginsWith: 'MorphWithModel') not]! !


!NewParagraph methodsFor: 'composition' stamp: 'jmv 1/15/2005 20:46'!
OLDcomposeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY 
	"While the section from start to stop has changed, composition may ripple all the way to the end of the text.  However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"

	| charIndex lineY lineHeight scanner line row firstLine lineHeightGuess saveCharIndex hitCR maybeSlide sliding bottom priorIndex priorLine |
	charIndex := start.
	lines := lineColl.
	lineY := startingY.
	lineHeightGuess := textStyle lineGrid.
	maxRightX := container left.
	maybeSlide := stop < text size and: [container isMemberOf: Rectangle].
	sliding := false.
	priorIndex := 1.
	bottom := container bottom.
	scanner := CompositionScanner new text: text textStyle: textStyle.
	firstLine := true.
	[charIndex <= text size and: [lineY + lineHeightGuess <= bottom]] 
		whileTrue: 
			[sliding 
				ifTrue: 
					["Having detected the end of rippling recoposition, we are only sliding old lines"

					priorIndex < priorLines size 
						ifTrue: 
							["Adjust and re-use previously composed line"

							priorIndex := priorIndex + 1.
							priorLine := (priorLines at: priorIndex) slideIndexBy: delta
										andMoveTopTo: lineY.
							lineColl addLast: priorLine.
							lineY := priorLine bottom.
							charIndex := priorLine last + 1]
						ifFalse: 
							["There are no more priorLines to slide."

							sliding := maybeSlide := false]]
				ifFalse: 
					[lineHeight := lineHeightGuess.
					saveCharIndex := charIndex.
					hitCR := false.
					row := container rectanglesAt: lineY height: lineHeight.
					1 to: row size
						do: 
							[:i | 
							(charIndex <= text size and: [hitCR not]) 
								ifTrue: 
									[line := scanner 
												composeFrom: charIndex
												inRectangle: (row at: i)
												firstLine: firstLine
												leftSide: i = 1
												rightSide: i = row size.
									lines addLast: line.
									(text at: line last) = Character cr ifTrue: [hitCR := true].
									lineHeight := lineHeight max: line lineHeight.	"includes font changes"
									charIndex := line last + 1]].
					lineY := lineY + lineHeight.
					row notEmpty 
						ifTrue: 
							[lineY > bottom 
								ifTrue: 
									["Oops -- the line is really too high to fit -- back out"

									charIndex := saveCharIndex.
									row do: [:r | lines removeLast]]
								ifFalse: 
									["It's OK -- the line still fits."

									maxRightX := maxRightX max: scanner rightX.
									1 to: row size - 1
										do: 
											[:i | 
											"Adjust heights across row if necess"

											(lines at: lines size - row size + i) lineHeight: lines last lineHeight
												baseline: lines last baseline].
									charIndex > text size 
										ifTrue: 
											["end of text"

											hitCR 
												ifTrue: 
													["If text ends with CR, add a null line at the end"

													lineY + lineHeightGuess <= container bottom 
														ifTrue: 
															[row := container rectanglesAt: lineY height: lineHeightGuess.
															row notEmpty 
																ifTrue: 
																	[line := (TextLine 
																				start: charIndex
																				stop: charIndex - 1
																				internalSpaces: 0
																				paddingWidth: 0)
																				rectangle: row first;
																				lineHeight: lineHeightGuess baseline: textStyle baseline.
																	lines addLast: line]]].
											lines := lines asArray.
											^maxRightX].
									firstLine := false]].
					(maybeSlide and: [charIndex > stop]) 
						ifTrue: 
							["Check whether we are now in sync with previously composed lines"

							
							[priorIndex < priorLines size 
								and: [(priorLines at: priorIndex) first < (charIndex - delta)]] 
									whileTrue: [priorIndex := priorIndex + 1].
							(priorLines at: priorIndex) first = (charIndex - delta) 
								ifTrue: 
									["Yes -- next line will have same start as prior line."

									priorIndex := priorIndex - 1.
									maybeSlide := false.
									sliding := true]
								ifFalse: 
									[priorIndex = priorLines size 
										ifTrue: 
											["Weve reached the end of priorLines,
								so no use to keep looking for lines to slide."

											maybeSlide := false]]]]].
	firstLine 
		ifTrue: 
			["No space in container or empty text"

			line := (TextLine 
						start: start
						stop: start - 1
						internalSpaces: 0
						paddingWidth: 0)
						rectangle: (container topLeft extent: 0 @ lineHeightGuess);
						lineHeight: lineHeightGuess baseline: textStyle baseline.
			lines := Array with: line]
		ifFalse: [self fixLastWithHeight: lineHeightGuess].
	"end of container"
	lines := lines asArray.
	^maxRightX! !

!NewParagraph methodsFor: 'composition' stamp: 'jmv 11/6/2008 18:16'!
composeLinesFrom: start to: stop delta: delta into: lineColl priorLines: priorLines atY: startingY 
	"While the section from start to stop has changed, composition may ripple all the way to the end of the text.  However in a rectangular container, if we ever find a line beginning with the same character as before (ie corresponding to delta in the old lines), then we can just copy the old lines from there to the end of the container, with adjusted indices and y-values"

	| newResult |
	newResult := TextComposer new 
				composeLinesFrom: start
				to: stop
				delta: delta
				into: lineColl
				priorLines: priorLines
				atY: startingY
				textStyle: textStyle
				text: text
				container: container.
	lines := newResult first asArray.
	maxRightX := newResult second.
	^maxRightX! !

!NewParagraph methodsFor: 'composition' stamp: 'jmv 1/15/2005 20:46'!
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)! !

!NewParagraph methodsFor: 'composition' stamp: 'jmv 11/6/2008 18:25'!
testNewComposeAll
	| newResult |
	self 
		OLDcomposeLinesFrom: 1
		to: text size
		delta: 0
		into: OrderedCollection new
		priorLines: Array new
		atY: container top.
	newResult := TextComposer new 
				composeLinesFrom: 1
				to: text size
				delta: 0
				into: OrderedCollection new
				priorLines: Array new
				atY: container top
				textStyle: textStyle
				text: text
				container: container.
	newResult first with: lines
		do: [:e1 :e2 | e1 longPrintString = e2 longPrintString ifFalse: [self halt]].
	newResult second = maxRightX ifFalse: [self halt].
	^{ 
		newResult.
		{ 
			lines.
			maxRightX}}! !


!ObjectExplorer methodsFor: 'accessing' stamp: 'jmv 3/23/2009 19:41'!
explorerFor: anObject 
	| window listMorph |
	rootObject := anObject.
	window := (SystemWindow labelled: (rootObject printStringLimitedTo: 64)) model: self.
	window addMorph: (listMorph := SimpleHierarchicalListMorph 
						on: self
						list: #getList
						selected: #getCurrentSelection
						changeSelected: #noteNewSelection:
						menu: #genericMenu:
						keystroke: #explorerKey:from:)
		frame: (0 @ 0 corner: 1 @ 0.8).
	window 
		addMorph: ((PluggableTextMorph 
				on: self
				text: #trash
				accept: #trash:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:) askBeforeDiscardingEdits: false)
		frame: (0 @ 0.8 corner: 1 @ 1).
	listMorph autoDeselect: false.
	^window! !


!OneLineEditorMorph methodsFor: 'drawing' stamp: 'jmv 11/5/2008 13:50'!
characterIndexAtPoint: aPoint

	| line block f |
	f _ self fontToUse.
	
	line _ TextLine 
		start: 1
		stop: contents size
		internalSpaces: 0
		paddingWidth: 0.
	line
		rectangle: bounds;
		lineHeight: f height baseline: f ascent.
		
	block _ (CharacterBlockScanner new text: contents asText textStyle: (TextStyle fontArray: {f}))
		characterBlockAtPoint: aPoint index: nil
		in: line.

	^ block stringIndex! !

!OneLineEditorMorph methodsFor: 'editing' stamp: 'jmv 11/4/2008 15:49'!
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 the editor to Morphic keyboard events"

	| oldEditor oldContents |
	self editor sensor: (KeyboardBuffer new startingEvent: evt).
	oldEditor := editor.
	oldContents := contents.
	interactionBlock value.
	oldContents == contents 
		ifTrue: 
			["this will not work if the paragraph changed"

			editor := oldEditor	"since it may have been changed while in block"].
	self changed! !


!PNGReadWriter class methodsFor: 'as yet unclassified' stamp: 'jmv 1/15/2005 20:24'!
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}! !


!PasteUpMorph methodsFor: 'dropping/grabbing' stamp: 'jmv 1/15/2005 20:35'!
acceptDroppingMorph: dropped event: evt 
	"The supplied morph, known to be acceptable to the receiver, is now to be assimilated; the precipitating event is supplied"

	| aMorph |
	aMorph := self morphToDropFrom: dropped.
	self isWorldMorph 
		ifTrue: 
			["Add the given morph to this world and start stepping it if it wants to be."

			self addMorphFront: aMorph.
			(aMorph fullBounds intersects: self viewBox) 
				ifFalse: 
					[Beeper beep.
					aMorph position: self bounds center]]
		ifFalse: [super acceptDroppingMorph: aMorph event: evt].
	aMorph submorphsDo: [:m | (m isKindOf: HaloMorph) ifTrue: [m delete]].
	self world startSteppingSubmorphsOf: aMorph! !

!PasteUpMorph methodsFor: 'user interface' stamp: 'jmv 1/15/2005 20:24'!
modelWakeUp
	"I am the model of a SystemWindow, that has just been activated"

	| aWindow |
	owner isNil ifTrue: [^self].	"Not in Morphic world"
	(owner isKindOf: TransformMorph) 
		ifTrue: [^self viewBox: self fullBounds].
	(aWindow := self containingWindow) ifNotNil: 
			[self viewBox = aWindow panelRect 
				ifFalse: [self viewBox: aWindow panelRect]]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:16'!
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: 'jmv 5/20/2006 16:38'!
buildWorldMenu: evt 
	^(TheWorldMenu new 
		world: self
		hand: evt hand) buildWorldMenu	"mvc??"! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 3/27/2009 09:57'!
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: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:16'!
expandAll
	"Expand all windows"

	(SystemWindow windowsIn: self satisfying: [:w | w isCollapsed]) 
		reverseDo: 
			[:w | 
			w collapseOrExpand.
			self displayWorld]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:35'!
findDirtyBrowsers: evt 
	"Present a menu of window titles for browsers with changes,
	and activate the one that gets chosen."

	| menu |
	menu := MenuMorph new.
	(SystemWindow windowsIn: self
		satisfying: [:w | (w model isKindOf: Browser) and: [w model canDiscardEdits not]]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activate].
	menu submorphs notEmpty ifTrue: [menu popUpEvent: evt in: self]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:35'!
findDirtyWindows: evt 
	"Present a menu of window titles for all windows with changes,
	and activate the one that gets chosen."

	| menu |
	menu := MenuMorph new.
	(SystemWindow windowsIn: self
		satisfying: [:w | w model canDiscardEdits not]) do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activate].
	menu submorphs notEmpty ifTrue: [menu popUpEvent: evt in: self]! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:35'!
findWindow: evt 
	"Present a menu names of windows and naked morphs, and activate the one that gets chosen.  Collapsed windows appear below line, expand if chosen; naked morphs appear below second line; if any of them has been given an explicit name, that is what's shown, else the class-name of the morph shows; if a naked morph is chosen, bring it to front and have it don a halo."

	| menu expanded collapsed nakedMorphs |
	menu := MenuMorph new.
	expanded := SystemWindow windowsIn: self
				satisfying: [:w | w isCollapsed not].
	collapsed := SystemWindow windowsIn: self
				satisfying: [:w | w isCollapsed].
	nakedMorphs := self submorphsSatisfying: [:m | m isSystemWindow not].
	expanded isEmpty & (collapsed isEmpty & nakedMorphs isEmpty) 
		ifTrue: [^Beeper beep].
	(expanded 
		asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #activateAndForceLabelToShow.
				w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	expanded isEmpty | (collapsed isEmpty & nakedMorphs isEmpty) 
		ifFalse: [menu addLine].
	(collapsed 
		asSortedCollection: [:w1 :w2 | w1 label caseInsensitiveLessOrEqual: w2 label]) 
			do: 
				[:w | 
				menu 
					add: w label
					target: w
					action: #collapseOrExpand.
				w model canDiscardEdits ifFalse: [menu lastItem color: Color red]].
	nakedMorphs isEmpty ifFalse: [menu addLine].
	(nakedMorphs asSortedCollection: 
			[:w1 :w2 | 
			w1 nameForFindWindowFeature 
				caseInsensitiveLessOrEqual: w2 nameForFindWindowFeature]) 
		do: 
			[:w | 
			menu 
				add: w nameForFindWindowFeature
				target: w
				action: #comeToFrontAndAddHalo].
	menu addTitle: 'find window' translated.
	menu popUpEvent: evt in: self! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:22'!
putUpNewMorphMenu
	"Put up the New Morph menu in the world"

	(TheWorldMenu new)
		adaptToWorld: self;
		newMorph! !

!PasteUpMorph methodsFor: 'world menu' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
deleteAllHalos
	self haloMorphs do: 
			[:m | 
			(m target isKindOf: SelectionMorph) ifTrue: [m target delete].
			m delete]! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:16'!
fullRepaintNeeded
	worldState doFullRepaint.
	SystemWindow windowsIn: self
		satisfying: 
			[:w | 
			w makeMeVisible.
			false]! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jmv 10/18/2006 22:27'!
install
	owner := nil.	"since we may have been inside another world previously"
	ActiveWorld := self.
	ActiveHand := self hands first.	"default"
	ActiveEvent := nil.
	submorphs do: [:ss | ss owner isNil ifTrue: [ss privateOwner: self]].
	"Transcript that was in outPointers and then got deleted."
	self viewBox: Display boundingBox.
	Sensor flushAllButDandDEvents.
	worldState handsDo: [:h | h initForEvents].
	self borderWidth: 0.	"default"
	SystemWindow noteTopWindowIn: self.
	self displayWorldSafely! !

!PasteUpMorph methodsFor: 'world state' stamp: 'jmv 1/15/2005 20:25'!
restoreMorphicDisplay
	DisplayScreen startUp.
	self
		extent: Display extent;
		viewBox: Display boundingBox;
		handsDo: 
				[:h | 
				h
					visible: true;
					showTemporaryCursor: nil];
		fullRepaintNeeded.
	WorldState addDeferredUIMessage: [Cursor normal show]! !


!Pen methodsFor: 'operations' stamp: 'jmv 1/15/2005 20:23'!
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 
		ifTrue: 
			["pixels"

			^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
				borderWidth: sourceForm width
				borderColor: myColor.	"not used"
	pm
		makeOpen;
		makeForwardArrow.
	anArrowSpec ifNotNil: [pm arrowSpec: anArrowSpec].
	af := pm arrowForms first.
	"render it onto the destForm"
	(FormCanvas on: destForm) 
		stencil: af
		at: af offset + (1 @ 1)
		color: myColor	"Display"! !


!PointerFinder methodsFor: 'morphic ui' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:23'!
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: 'event handling' stamp: 'jmv 1/15/2005 20:23'!
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: 
					[:vertPt :vertIndex | 
					"Check for click-to-drag at handle site"

					((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: 'menu' stamp: 'jmv 3/27/2009 09:57'!
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 class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20:24'!
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: 'instance creation' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20:23'!
from: startPoint to: endPoint color: lineColor width: lineWidth 
	^PolygonMorph 
		vertices: { 
				startPoint.
				endPoint}
		color: Color black
		borderWidth: lineWidth
		borderColor: lineColor! !


!PopUpMenu methodsFor: 'basic control sequence' stamp: 'jmv 2/12/2008 19:11'!
startUpWithCaption: captionOrNil at: location allowKeyboard: aBoolean 
	"Display the menu, with caption if supplied. Wait for the mouse button to go down, then track the selection as long as the button is pressed. When the button is released,
	Answer the index of the current selection, or zero if the mouse is not released over  any menu item. Location specifies the desired topLeft of the menu body rectangle. The final argument indicates whether the menu should seize the keyboard focus in order to allow the user to navigate it via the keyboard."

	| maxHeight |
	maxHeight := Display height * 3 // 4.
	self frameHeight > maxHeight 
		ifTrue: 
			[^self 
				startUpSegmented: maxHeight
				withCaption: captionOrNil
				at: location
				allowKeyboard: aBoolean].
	selection := Cursor normal showWhile: 
							[(MVCMenuMorph from: self title: captionOrNil) 
								invokeAt: location
								in: ActiveWorld
								allowKeyboard: aBoolean].
			^selection! !


!Preference methodsFor: 'menu' stamp: 'jmv 2/15/2008 00:13'!
offerPreferenceNameMenu: aPanel with: ignored1 in: ignored2 
	"the user clicked on a preference name -- put up a menu"

	| aMenu |
	ActiveHand showTemporaryCursor: nil.
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addTitle: name.
	aMenu 
		add: 'browse senders'
		target: Smalltalk
		selector: #browseAllCallsOn:
		argument: name.
	aMenu 
		balloonTextForLastItem: 'This will open a method-list browser on all methods that the send the preference "' 
				, name , '".'.
	aMenu 
		add: 'show category...'
		target: aPanel
		selector: #findCategoryFromPreference:
		argument: name.
	aMenu 
		balloonTextForLastItem: 'Allows you to find out which category, or categories, this preference belongs to.'.
	aMenu 
				add: 'hand me a button for this preference'
				target: self
				selector: #tearOffButton.
			aMenu 
				balloonTextForLastItem: 'Will give you a button that governs this preference, which you may deposit wherever you wish'.
	aMenu 
		add: 'copy this name to clipboard'
		target: self
		selector: #copyName.
	aMenu 
		balloonTextForLastItem: 'Copy the name of the preference to the text clipboard, so that you can paste into code somewhere'.
	aMenu popUpInWorld! !

!Preference methodsFor: 'button' stamp: 'jmv 5/21/2006 19:44'!
representativeButtonWithColor: aColor inPanel: aPreferencesPanel 
	"Return a button that controls the setting of prefSymbol.  It will keep up to date even if the preference value is changed in a different place"

	| outerButton aButton str miniWrapper |
	outerButton := AlignmentMorph newRow height: 24.
	outerButton 
		color: (aColor ifNil: 
					[Color 
						r: 0.645
						g: 1.0
						b: 1.0]).
	outerButton 
		hResizing: (aPreferencesPanel ifNil: [#shrinkWrap] ifNotNil: [#spaceFill]).
	outerButton vResizing: #shrinkWrap.
	outerButton 
		addMorph: (aButton := UpdatingThreePhaseButtonMorph checkBox).
	aButton
		target: self;
		actionSelector: #togglePreferenceValue;
		getSelector: #preferenceValue.
	outerButton addTransparentSpacerOfSize: 2 @ 0.
	str := StringMorph contents: name
				font: (StrikeFont familyName: 'NewYork' size: 12).
	miniWrapper := (AlignmentMorph newRow)
				hResizing: #shrinkWrap;
				vResizing: #shrinkWrap.
	miniWrapper beTransparent addMorphBack: str lock.
	aPreferencesPanel ifNotNil: 
			["We're in a Preferences panel"

			miniWrapper 
				on: #mouseDown
				send: #offerPreferenceNameMenu:with:in:
				to: self
				withValue: aPreferencesPanel.
			miniWrapper 
				on: #mouseEnter
				send: #menuButtonMouseEnter:
				to: miniWrapper.
			miniWrapper 
				on: #mouseLeave
				send: #menuButtonMouseLeave:
				to: miniWrapper.
			miniWrapper 
				setBalloonText: 'Click here for a menu of options regarding this preference.  Click on the checkbox to the left to toggle the setting of this preference']
		ifNil: 
			["We're a naked button, not in a panel"

			miniWrapper
				setBalloonText: helpString;
				setProperty: #balloonTarget toValue: aButton].
	outerButton addMorphBack: miniWrapper.
	outerButton setNameTo: name.
	aButton setBalloonText: helpString.
	^outerButton

	"(Preferences preferenceAt: #balloonHelpEnabled) tearOffButton"! !


!Preferences class methodsFor: 'fonts' stamp: 'jmv 1/15/2005 20:35'!
chooseBalloonHelpFont
	BalloonMorph chooseBalloonFont! !

!Preferences class methodsFor: 'fonts' stamp: 'jmv 2/26/2009 13:44'!
fontConfigurationMenu
	| aMenu |
	aMenu := MenuMorph new defaultTarget: Preferences.
	aMenu addTitle: 'Standard System Fonts' translated.
	aMenu addStayUpIcons.
	aMenu add: 'default text font...' translated action: #chooseSystemFont.
	aMenu 
		balloonTextForLastItem: 'Choose the default font to be used for code and  in workspaces, transcripts, etc.' 
				translated.
	aMenu lastItem font: Preferences standardDefaultTextFont.
	aMenu add: 'list font...' translated action: #chooseListFont.
	aMenu lastItem font: Preferences standardListFont.
	aMenu balloonTextForLastItem: 'Choose the font to be used in list panes' 
				translated.
	aMenu add: 'menu font...' translated action: #chooseMenuFont.
	aMenu lastItem font: Preferences standardMenuFont.
	aMenu 
		balloonTextForLastItem: 'Choose the font to be used in menus' translated.
	aMenu add: 'window-title font...' translated action: #chooseWindowTitleFont.
	aMenu lastItem font: Preferences windowTitleFont.
	aMenu 
		balloonTextForLastItem: 'Choose the font to be used in window titles.' 
				translated.
	aMenu add: 'balloon-help font...' translated action: #chooseBalloonHelpFont.
	aMenu lastItem font: Preferences standardBalloonHelpFont.
	aMenu 
		balloonTextForLastItem: 'choose the font to be used when presenting balloon help.' 
				translated.
	aMenu add: 'code font...' translated action: #chooseCodeFont.
	aMenu lastItem font: Preferences standardCodeFont.
	aMenu balloonTextForLastItem: 'Choose the font to be used in code panes.' 
				translated.
	aMenu addLine.
	aMenu add: 'restore default font choices' translated
		action: #restoreDefaultFonts.
	aMenu 
		balloonTextForLastItem: 'Use the standard system font defaults' translated.
	aMenu add: 'print default font choices' translated
		action: #printStandardSystemFonts.
	aMenu 
		balloonTextForLastItem: 'Print the standard system font defaults to the Transcript' 
				translated.
	^aMenu! !

!Preferences class methodsFor: 'fonts' stamp: 'jmv 1/15/2005 20:35'!
refreshFontSettings
	"Try to update all the current font settings to make things consistent."

	self
		setWindowTitleFontTo: self windowTitleFont;
		setListFontTo: self standardListFont;
		setMenuFontTo: self standardMenuFont;
		setSystemFontTo: TextStyle defaultFont;
		setCodeFontTo: self standardCodeFont;
		setBalloonHelpFontTo: BalloonMorph balloonFont.
	SystemWindow allSubInstancesDo: 
			[:s | 
			| rawLabel |
			rawLabel := s getRawLabel.
			rawLabel owner vResizing: #spaceFill.
			rawLabel font: rawLabel font.
			s setLabel: s label.
			s replaceBoxes]! !

!Preferences class methodsFor: 'fonts' stamp: 'jmv 1/15/2005 20:35'!
standardBalloonHelpFont
	^BalloonMorph balloonFont! !

!Preferences class methodsFor: 'misc' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:34'!
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: 'parameters' stamp: 'jmv 2/12/2008 19:14'!
annotationEditingWindow
	"Answer a window affording editing of annotations"

	| aPanel ins outs current aMorph aWindow aButton info pair standardHeight |
	standardHeight := 140.
	aPanel := AlignmentMorph newRow extent: 300 @ standardHeight.
	ins := AlignmentMorph newColumn extent: 150 @ standardHeight.
	ins color: Color green muchLighter.
	ins
		enableDrop: true;
		beSticky.
	outs := AlignmentMorph newColumn extent: 150 @ standardHeight.
	outs color: Color red muchLighter.
	outs
		enableDrop: true;
		beSticky.
	aPanel
		addMorph: outs;
		addMorphFront: ins.
	outs position: ins position + (200 @ 0).
	current := self defaultAnnotationRequests.
	info := self annotationInfo.
	current do: 
			[:sym | 
			pair := info detect: [:aPair | aPair first == sym].
			aMorph := StringMorph new contents: pair first.
			aMorph setBalloonText: pair last.
			aMorph enableDrag: true.
			aMorph 
				on: #startDrag
				send: #startDrag:with:
				to: aMorph.
			ins addMorphBack: aMorph].
	info do: 
			[:aPair | 
			(current includes: aPair first) 
				ifFalse: 
					[aMorph := StringMorph new contents: aPair first.
					aMorph setBalloonText: aPair last.
					aMorph enableDrag: true.
					aMorph 
						on: #startDrag
						send: #startDrag:with:
						to: aMorph.
					outs addMorph: aMorph]].
	aPanel layoutChanged.
	aWindow := SystemWindowWithButton new setLabel: 'Annotations'.
	aButton := (SimpleButtonMorph new)
				target: Preferences;
				actionSelector: #acceptAnnotationsFrom:;
				arguments: (Array with: aWindow);
				label: 'apply';
				borderWidth: 0;
				borderColor: Color transparent;
				color: Color transparent.
	aButton submorphs first color: Color blue.
	aButton 
		setBalloonText: 'After moving all the annotations you want to the left (green) side, and all the ones you do NOT want to the right (pink) side, hit this "apply" button to have your choices take effect.'.
	aWindow
		buttonInTitle: aButton;
		adjustExtraButton.
	^aPanel wrappedInWindow: aWindow

	"Preferences annotationEditingWindow openInHand"! !

!Preferences class methodsFor: 'reacting to change' stamp: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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! !


!ProcessBrowser class methodsFor: 'CPU utilization' stamp: 'jmv 2/12/2008 19:15'!
tallyCPUUsageFor: seconds every: msec 
	"Compute CPU usage using a msec millisecond sample for the given number of seconds,
	then dump the usage statistics on the Transcript. The UI is free to continue, meanwhile"

	"ProcessBrowser tallyCPUUsageFor: 10 every: 100"

	| promise |
	promise := Processor tallyCPUUsageFor: seconds every: msec.
	
	[| tally |
	tally := promise value.
	WorldState addDeferredUIMessage: [self dumpTallyOnTranscript: tally]] 
			fork! !


!RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:16'!
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! !

!RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'jmv 2/12/2008 19:16'!
initialFrameFor: aView initialExtent: initialExtent world: aWorld 
	"Find a plausible initial screen area for the supplied view, which should be a StandardSystemView, taking into account the 'reverseWindowStagger' Preference, the size needed, and other windows currently on the screen."

	| allOrigins screenRight screenBottom putativeOrigin putativeFrame allowedArea staggerOrigin otherFrames |
	Preferences reverseWindowStagger 
		ifTrue: 
			[^self 
				strictlyStaggeredInitialFrameFor: aView
				initialExtent: initialExtent
				world: aWorld].
	allowedArea := self maximumUsableAreaInWorld: aWorld.
	screenRight := allowedArea right.
	screenBottom := allowedArea bottom.
	otherFrames := (SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) 
						collect: [:w | w bounds].
	allOrigins := otherFrames collect: [:f | f origin].
	(self standardPositionsInWorld: aWorld) do: 
			[:aPosition | 
			"First see if one of the standard positions is free"

			(allOrigins includes: aPosition) 
				ifFalse: 
					[^(aPosition extent: initialExtent) 
						translatedAndSquishedToBeWithin: allowedArea]].
	staggerOrigin := (self standardPositionsInWorld: aWorld) first.	"Fallback: try offsetting from top left"
	putativeOrigin := staggerOrigin.
	
	[putativeOrigin := putativeOrigin + StaggerOffset.
	putativeFrame := putativeOrigin extent: initialExtent.
	putativeFrame bottom < screenBottom 
		and: [putativeFrame right < screenRight]] 
			whileTrue: 
				[(allOrigins includes: putativeOrigin) 
					ifFalse: 
						[^(putativeOrigin extent: initialExtent) 
							translatedAndSquishedToBeWithin: allowedArea]].
	^(self scrollBarSetback @ self screenTopSetback extent: initialExtent) 
		translatedAndSquishedToBeWithin: allowedArea! !

!RealEstateAgent class methodsFor: 'as yet unclassified' stamp: 'jmv 2/12/2008 19:17'!
strictlyStaggeredInitialFrameFor: aStandardSystemView initialExtent: initialExtent world: aWorld 
	"This method implements a staggered window placement policy that I (di) like.
	Basically it provides for up to 4 windows, staggered from each of the 4 corners.
	The windows are staggered so that there will always be a corner visible."

	| allowedArea grid initialFrame otherFrames cornerSel corner delta putativeCorner free maxLevel |
	allowedArea := (self maximumUsableAreaInWorld: aWorld) 
				insetBy: (self scrollBarSetback @ self screenTopSetback extent: 0 @ 0).
	"Number to be staggered at each corner (less on small screens)"
	maxLevel := allowedArea area > 300000 ifTrue: [3] ifFalse: [2].
	"Amount by which to stagger (less on small screens)"
	grid := allowedArea area > 500000 ifTrue: [40] ifFalse: [20].
	initialFrame := 0 @ 0 extent: initialExtent.
	"min: (allowedArea extent - (grid*(maxLevel+1*2) + (grid//2))))
							min: 600@400"
	otherFrames := (SystemWindow windowsIn: aWorld satisfying: [:w | w isCollapsed not]) 
						collect: [:w | w bounds].
	0 to: maxLevel
		do: 
			[:level | 
			1 to: 4
				do: 
					[:ci | 
					cornerSel := #(#topLeft #topRight #bottomRight #bottomLeft) at: ci.
					corner := allowedArea perform: cornerSel.
					"The extra grid//2 in delta helps to keep title tabs distinct"
					delta := ((maxLevel - level) * grid + (grid // 2)) @ (level * grid).
					1 to: ci - 1 do: [:i | delta := delta rotateBy: #right centerAt: 0 @ 0].	"slow way"
					putativeCorner := corner + delta.
					free := true.
					otherFrames 
						do: [:w | free := free & ((w perform: cornerSel) ~= putativeCorner)].
					free 
						ifTrue: 
							[^(initialFrame align: (initialFrame perform: cornerSel)
								with: putativeCorner) translatedAndSquishedToBeWithin: allowedArea]]].
	"If all else fails..."
	^(self scrollBarSetback @ self screenTopSetback 
		extent: initialFrame extent) translatedAndSquishedToBeWithin: allowedArea! !


!AlignmentMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:39'!
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: 'jmv 8/26/2008 11:35'!
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.
	result setNameTo: '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 8/26/2008 11:35'!
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.
	result setNameTo: '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 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:34'!
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 methodsFor: 'initialization' stamp: 'jmv 5/28/2006 23:18'!
initializeFor: aTarget fromDictionary: aDictionary 
	"Initialize me for a target and a dictionary."

	| imageWrapper anIndex aButton controlsWrapper asm |
	self listDirection: #topToBottom.
	self addMorphBack: (controlsWrapper := AlignmentMorph newRow).
	self baseDictionary: aDictionary.
	target := aTarget.
	coexistWithOriginal := true.
	self
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap.
	controlsWrapper
		borderWidth: 0;
		layoutInset: 0;
		hResizing: #shrinkWrap;
		vResizing: #shrinkWrap;
		extent: 5 @ 5.
	controlsWrapper
		wrapCentering: #topLeft;
		color: Color white;
		vResizing: #spaceFill.
	controlsWrapper addTransparentSpacerOfSize: 18 @ 0.
	controlsWrapper addMorphBack: ((IconicButton new)
				borderWidth: 0;
				labelGraphic: (ScriptingSystem formAtKey: 'TinyMenu');
				color: Color transparent;
				actWhen: #buttonDown;
				actionSelector: #showMenu;
				target: self;
				setBalloonText: 'menu').
	controlsWrapper addTransparentSpacerOfSize: 14 @ 0.
	aButton := (SimpleButtonMorph new)
				target: self;
				borderColor: Color black.
	controlsWrapper addMorphBack: (aButton
				label: 'Prev';
				actionSelector: #downArrowHit;
				actWhen: #whilePressed;
				setBalloonText: 'show previous picture';
				yourself).
	controlsWrapper addTransparentSpacerOfSize: 15 @ 0.
	aButton := (SimpleButtonMorph new)
				target: self;
				borderColor: Color black.
	controlsWrapper addMorphBack: (aButton
				label: 'Next';
				actionSelector: #upArrowHit;
				actWhen: #whilePressed;
				setBalloonText: 'show next pictutre').
	self addMorphBack: controlsWrapper.
	self addTransparentSpacerOfSize: 0 @ 12.
	self addMorphBack: (asm := (UpdatingStringMorph new)
						contents: ' ';
						target: self;
						putSelector: #renameGraphicTo:;
						getSelector: #truncatedNameOfGraphic).
	asm setBalloonText: 'The name of the current graphic'.
	self addTransparentSpacerOfSize: 0 @ 12.
	self addMorphBack: ((AlignmentMorph newRow)
				height: 4;
				borderWidth: 0;
				color: Color black).
	imageWrapper := (Morph new)
				color: Color transparent;
				extent: 190 @ 82.
	imageWrapper 
		addMorphBack: (formDisplayMorph := ImageMorph new extent: 100 @ 100).
	self addMorphBack: imageWrapper.
	target ifNotNil: 
			[(anIndex := formChoices indexOf: target form ifAbsent: []) 
				ifNotNil: [currentIndex := anIndex]].
	self updateThumbnail! !

!GraphicalDictionaryMenu methodsFor: 'menu commands' stamp: 'jmv 3/27/2009 09:57'!
showMenu
	"Show the receiver's menu"
	| aMenu |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu title: 'Graphics Library'.
	aMenu addStayUpItem.
	aMenu addList: #(#('remove' #removeEntry 'Remove this entry from the dictionary') #('rename' #renameEntry 'Rename this entry') #- #('browse symbol references' #browseIconReferences 'Browse methods that refer to this icon''s name') #('browse string references' #browseStringIconReferences '
													' #Browse #methods #that #refer #to #string #constants #that #contian #this #icon '' #s #name) #('copy name' #copyName 'Copy the name of this graphic to the clipboard') #- #('find...' #findEntry 'Find an entry by name') #('find again' #findAgain 'Find the next match for the keyword previously searched for') ).
	aMenu popUpInWorld! !


!GraphicalDictionaryMenu class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:21'!
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: 'jmv 1/15/2005 20:35'!
items
	^submorphs select: [:m | m isKindOf: MenuItemMorph]! !

!MenuMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:35'!
lastItem
	^submorphs reverse detect: [:m | m isKindOf: MenuItemMorph]
		ifNone: [submorphs last]! !

!MenuMorph methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 3/13/2009 10:05'!
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."

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

!MenuMorph methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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;
				addMorphBack: closeBox;
				addMorphBack: title;
				addMorphBack: pinBox).	"Preferences menuTitleColor"
	self setProperty: #hasTitlebarWidgets toValue: true.
	self removeProperty: #needsTitlebarWidgets.
	self removeStayUpItems! !

!MenuMorph methodsFor: 'construction' stamp: 'jmv 5/28/2006 23:18'!
addTitle: aString updatingSelector: aSelector updateTarget: aTarget 
	"Add a title line at the top of this menu Make aString its initial 
	contents.  
	If aSelector is not nil, then periodically obtain fresh values for its 
	contents by sending aSelector to aTarget.."

	| title |
	title := AlignmentMorph new.
	self setTitleParametersFor: title.
	title vResizing: #shrinkWrap.
	title listDirection: #topToBottom.
	title
		wrapCentering: #center;
		cellPositioning: #topCenter;
		layoutInset: 0.
	aSelector ifNil: 
			[(aString asString findTokens: String cr) do: 
					[:line | 
					title addMorphBack: ((StringMorph new)
								contents: line;
								font: Preferences standardMenuFont)]]
		ifNotNil: 
			[title addMorphBack: ((UpdatingStringMorph new)
						lock;
						font: Preferences standardMenuFont;
						target: aTarget;
						getSelector: aSelector)].
	title setProperty: #titleString toValue: aString.
	self addMorphFront: title.
	(self hasProperty: #needsTitlebarWidgets) ifTrue: [self addStayUpIcons]! !

!MenuMorph methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 3/13/2009 10:06'!
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: 'jmv 8/26/2008 11:37'!
popUpAt: aPoint forHand: hand in: aWorld allowKeyboard: aBoolean 
	"Present this menu at the given point under control of the given  
	hand."

	| evt |
	self items isEmpty ifTrue: [^self].
	MenuIcons decorateMenu: self.
	(self submorphs select: [:m | m isKindOf: UpdatingMenuItemMorph]) 
		do: [:m | m updateContents].
	"precompute width"
	self 
		positionAt: aPoint
		relativeTo: (selectedItem ifNil: [self items first])
		inWorld: aWorld.
	aWorld addMorphFront: self.
	"Acquire focus for valid pop up behavior"
	hand newMouseFocus: self.
	aBoolean ifTrue: [hand newKeyboardFocus: self].
	evt := hand lastEvent.
	(evt isKeyboard or: [evt isMouse and: [evt anyButtonPressed not]]) 
		ifTrue: 
			["Select first item if button not down"

			self moveSelectionDown: 1 event: evt].
	self changed! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'jmv 1/15/2005 20:35'!
displayFiltered: evt 
	| matchStr allItems isMatch matches feedbackMorph |
	matchStr := self valueOfProperty: #matchString.
	allItems := self submorphs select: [:m | m isKindOf: MenuItemMorph].
	matches := allItems select: 
					[:m | 
					isMatch := matchStr isEmpty 
								or: [m contents includesSubstring: matchStr caseSensitive: false].
					m isEnabled: isMatch.
					isMatch].
	feedbackMorph := self valueOfProperty: #feedbackMorph.
	feedbackMorph ifNil: 
			[feedbackMorph := (TextMorph new)
						autoFit: true;
						color: Color darkGray.
			self
				addLine;
				addMorphBack: feedbackMorph lock.
			self setProperty: #feedbackMorph toValue: feedbackMorph.
			self fullBounds	"Lay out for submorph adjacency"].
	feedbackMorph contents: '<' , matchStr , '>'.
	matchStr isEmpty 
		ifTrue: 
			[feedbackMorph delete.
			self submorphs last delete.
			self removeProperty: #feedbackMorph].
	matches size = 1 ifTrue: [self selectItem: matches first event: evt]! !

!MenuMorph methodsFor: 'keyboard control' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 
			[:unused | 
			"Ensure finite"

			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: 'jmv 3/13/2009 10:07'!
detachSubMenu: evt 
	| possibleTargets item subMenu |
	possibleTargets _ evt hand argumentOrNil morphsAt: evt hand targetOffset.
	item _ possibleTargets detect: [ :any | any 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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:24'!
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 methodsFor: 'private' stamp: 'jmv 1/15/2005 20:35'!
getMenu: shiftPressed 
	"Answer the menu for this button, 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 |
	getMenuSelector isNil ifTrue: [^nil].
	menu := MenuMorph new defaultTarget: model.
	getMenuSelector numArgs = 1 
		ifTrue: [^model perform: getMenuSelector with: menu].
	getMenuSelector numArgs = 2 
		ifTrue: 
			[^model 
				perform: getMenuSelector
				with: menu
				with: shiftPressed].
	^self error: 'The getMenuSelector must be a 1- or 2-keyword symbol'! !


!PluggableButtonMorph class methodsFor: 'example' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:24'!
initLabelMorph
	^labelMorph := StringMorph contents: '' font: (self fontOfPointSize: 14)! !

!ProgressMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:35'!
initProgressMorph
	progress := ProgressBarMorph new.
	progress borderWidth: 1.
	progress color: Color white.
	progress progressColor: Color gray.
	progress extent: 200 @ 15! !

!ProgressMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:24'!
initSubLabelMorph
	^subLabelMorph := StringMorph contents: ''
				font: (self fontOfPointSize: 12)! !

!ProgressMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:35'!
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! !


!SampledSound methodsFor: 'sound tracks' stamp: 'jmv 1/15/2005 20:35'!
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! !


!ScrollPane methodsFor: 'access' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'initialization' stamp: 'jmv 5/28/2006 14:43'!
initializeScrollBars
	"initialize the receiver's scrollBar"

	(scrollBar := ScrollBar new model: self slotName: 'vScrollBar')
		borderWidth: 1;
		borderColor: Color black.
	(hScrollBar := ScrollBar new model: self slotName: 'hScrollBar')
		borderWidth: 1;
		borderColor: Color black.

	""
	scroller := TransformMorph new color: Color transparent.
	scroller offset: -3 @ 0.
	self addMorph: scroller.
	""
	retractableScrollBar 
		ifFalse: 
			[self
				addMorph: scrollBar;
				addMorph: hScrollBar].
	Preferences alwaysShowVScrollbar ifTrue: [self alwaysShowVScrollBar: true].
	Preferences alwaysHideHScrollbar 
		ifTrue: [self hideHScrollBarIndefinitely: true]
		ifFalse: 
			[Preferences alwaysShowHScrollbar ifTrue: [self alwaysShowHScrollBar: true]]! !

!ScrollPane methodsFor: 'menu' stamp: 'jmv 1/15/2005 20:35'!
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'! !


!PluggableListMorph methodsFor: 'as yet unclassified' stamp: 'jmv 1/15/2005 20:35'!
listMorphClass
	^LazyListMorph! !

!PluggableListMorph methodsFor: 'initialization' stamp: 'jmv 5/28/2006 23:32'!
list: listOfStrings 
	"lex doesn't think this is used any longer, but is not yet brave enough to remove it.  It should be removed eventually"

	"Set the receiver's list as specified"

	| morphList h loc index converter item textColor font |
	scroller removeAllMorphs.
	list := listOfStrings ifNil: [Array new].
	list isEmpty 
		ifTrue: 
			[self setScrollDeltas.
			^self selectedMorph: nil].
	"NOTE: we will want a quick StringMorph init message, possibly even
		combined with event install and positioning"
	font := Preferences standardListFont.
	converter := self valueOfProperty: #itemConversionMethod.
	converter ifNil: [converter := #asStringOrText].
	textColor := self valueOfProperty: #textColor.
	morphList := list collect: 
					[:each | 
					| stringMorph |
					item := each.
					item := item perform: converter.
					stringMorph := item isText 
								ifTrue: 
									[StringMorph 
										contents: item
										font: font
										emphasis: (item emphasisAt: 1)]
								ifFalse: [StringMorph contents: item font: font].
					textColor ifNotNil: [stringMorph color: textColor].
					stringMorph].
	self highlightSelector ifNotNil: 
			[model 
				perform: self highlightSelector
				with: list
				with: morphList].

	"Lay items out vertically and install them in the scroller"
	h := morphList first height.	"self listItemHeight"
	loc := 0 @ 0.
	morphList do: 
			[:m | 
			m bounds: (loc extent: 9999 @ h).
			loc := loc + (0 @ h)].
	scroller addAllMorphs: morphList.
	index := self getCurrentSelectionIndex.
	self selectedMorph: ((index = 0 or: [index > morphList size]) 
				ifTrue: [nil]
				ifFalse: [morphList at: index]).
	self setScrollDeltas.
	scrollBar setValue: 0.0! !


!PluggableTextMorph methodsFor: 'menu commands' stamp: 'jmv 3/27/2009 09:57'!
accept
	"Inform the model of text to be accepted, and return true if OK."

	"sps 8/13/2001 22:41: save selection and scroll info"

	| textToAccept ok saveSelection saveScrollerOffset |
	saveSelection := self selectionInterval copy.
	saveScrollerOffset := scroller offset copy.
	(self canDiscardEdits and: [(self hasProperty: #alwaysAccept) not]) 
		ifTrue: [^self flash].
	self hasEditingConflicts 
		ifTrue: 
			[(self 
				confirm: 'Caution!! This method may have been
changed elsewhere since you started
editing it here.  Accept anyway?' 
						translated) 
					ifFalse: [^self flash]].
	textToAccept := textMorph asText.
	ok := setTextSelector isNil or: 
					[setTextSelector numArgs = 2 
						ifTrue: 
							[model 
								perform: setTextSelector
								with: textToAccept
								with: self]
						ifFalse: [model perform: setTextSelector with: textToAccept]].
	ok == true 
		ifTrue: 
			[self setText: self getText.
			self hasUnacceptedEdits: false.
			(model dependents detect: 
					[:dep | 
					(dep isKindOf: PluggableTextMorph) 
						and: [dep getTextSelector == #annotation]]
				ifNone: [nil]) ifNotNilDo: [:aPane | model changed: #annotation]].

	"sps 8/13/2001 22:41: restore selection and scroll info"
	
	["During the step for the browser, updateCodePaneIfNeeded is called, and 
		invariably resets the contents of the codeholding PluggableTextMorph
		at that time, resetting the cursor position and scroller in the process.
		The following line forces that update without waiting for the step, 		then restores the cursor and scrollbar"

	ok 
		ifTrue: 
			["(don't bother if there was an error during compile)"

			(model isKindOf: CodeHolder) ifTrue: [model updateCodePaneIfNeeded].
			"jmv - moved this outside the deferred message.
			See 'Re: [squeak-dev] scrambled input fields'
			from Gary Chambers on Nov 14, 2008."
			self selectFrom: saveSelection first to: saveSelection last.
			WorldState addDeferredUIMessage: 
					[self currentHand newKeyboardFocus: textMorph.
					scroller offset: saveScrollerOffset.
					self setScrollDeltas.
					"self selectFrom: saveSelection first to: saveSelection last"]]] 
			on: Error
			do: []! !

!PluggableTextMorph methodsFor: 'menu commands' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 3/27/2009 09:57'!
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: 'jmv 1/15/2005 20:35'!
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! !


!SelectionMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:09'!
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: 'accessing' stamp: 'jmv 1/15/2005 20:09'!
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: 'dropping/grabbing' stamp: 'jmv 1/15/2005 20:25'!
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! !

!SelectionMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:12'!
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: 'jmv 1/15/2005 20:35'!
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! !


!SimpleButtonMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:24'!
label
	| s |
	s := ''.
	self 
		allMorphsDo: [:m | (m isKindOf: StringMorph) ifTrue: [s := m contents]].
	^s! !

!SimpleButtonMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:24'!
labelString: aString 
	| existingLabel |
	(existingLabel := self findA: StringMorph) ifNil: [self label: aString]
		ifNotNil: 
			[existingLabel contents: aString.
			self fitContents]! !


!IconicButton methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:39'!
borderInset
	self borderStyle: (BorderStyle inset width: 2)! !

!IconicButton methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:39'!
borderRaised
	self borderStyle: (BorderStyle raised width: 2)! !

!IconicButton methodsFor: 'as yet unclassified' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20:39'!
borderNormal
	self borderStyle: (BorderStyle width: 2 color: Color transparent)! !

!IconicButton methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:39'!
borderThick
	self 
		borderStyle: (BorderStyle width: 2 color: self raisedColor twiceDarker)! !


!SimpleHierarchicalListMorph methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:35'!
indentingItemClass
	^IndentingListItemMorph! !


!SimpleServiceEntry methodsFor: 'performing service' stamp: 'jmv 5/28/2006 14:40'!
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 setBalloonText: self description.
	Preferences alternativeWindowLook 
		ifTrue: 
			[aButton
				borderWidth: 2;
				borderColor: #raised].
	^aButton! !


!SketchMorph methodsFor: 'menus' stamp: 'jmv 1/15/2005 20:22'!
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: 'jmv 1/15/2005 20:11'!
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: 'initialization' stamp: 'jmv 5/28/2006 14:41'!
initializeModal: beModal 
	"Initialize the receiver.  If beModal is true, it will be a modal color picker, else not"

	isModal := beModal.
	self removeAllMorphs.
	isModal 
		ifFalse: 
			[theSelectorDisplayMorph := (AlignmentMorph newRow)
						color: Color white;
						borderWidth: 1;
						borderColor: Color red;
						hResizing: #shrinkWrap;
						vResizing: #shrinkWrap;
						addMorph: (StringMorph contents: 'theSelector').
			self addMorph: theSelectorDisplayMorph.
			self addMorph: ((SimpleButtonMorph new)
						borderWidth: 0;
						label: 'x' font: nil;
						color: Color transparent;
						actionSelector: #delete;
						target: self;
						position: self topLeft - (0 @ 3);
						extent: 10 @ 12;
						setCenteredBalloonText: 'dismiss color picker')].
	self addMorph: ((Morph newBounds: (DragBox translateBy: self topLeft))
				color: Color transparent;
				setCenteredBalloonText: 'put me somewhere').
	self 
		addMorph: ((Morph newBounds: (RevertBox translateBy: self topLeft))
				color: Color transparent;
				setCenteredBalloonText: 'restore original color').
	self 
		addMorph: ((Morph newBounds: (FeedbackBox translateBy: self topLeft))
				color: Color transparent;
				setCenteredBalloonText: 'shows selected color').
	self 
		addMorph: ((Morph newBounds: (TransparentBox translateBy: self topLeft))
				color: Color transparent;
				setCenteredBalloonText: 'adjust translucency').
	self buildChartForm.
	selectedColor ifNil: [selectedColor := Color white].
	sourceHand := nil.
	deleteOnMouseUp := false.
	updateContinuously := true! !

!ColorPickerMorph methodsFor: 'other' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:23'!
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: 'initialize' stamp: 'jmv 5/28/2006 14:45'!
initializeDownButton
	"initialize the receiver's downButton"

	downButton := RectangleMorph 
				newBounds: (self innerBounds bottomRight - self buttonExtent 
						extent: self buttonExtent)
				color: self thumbColor.
	downButton 
		on: #mouseDown
		send: #scrollDownInit
		to: self.
	downButton 
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	self updateDownButtonImage.
	downButton setBorderWidth: 1 borderColor: #raised.
	self addMorph: downButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 5/28/2006 14:47'!
initializeMenuButton
	"initialize the receiver's menuButton"

	"Preferences disable: #scrollBarsWithoutMenuButton"

	"Preferences enable: #scrollBarsWithoutMenuButton"

	(Preferences valueOfFlag: #scrollBarsWithoutMenuButton) ifTrue: [^self].
	menuButton := RectangleMorph 
						newBounds: (self innerBounds topLeft extent: self buttonExtent)
						color: self thumbColor.
	menuButton 
		on: #mouseEnter
		send: #menuButtonMouseEnter:
		to: self.
	menuButton 
		on: #mouseDown
		send: #menuButtonMouseDown:
		to: self.
	menuButton 
		on: #mouseLeave
		send: #menuButtonMouseLeave:
		to: self.
	"menuButton 
	addMorphCentered: (RectangleMorph 
	newBounds: (0 @ 0 extent: 4 @ 2) 
	color: Color black)."
	self updateMenuButtonImage.
	menuButton setBorderWidth: 1 borderColor: #raised.
	self addMorph: menuButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 5/28/2006 14:45'!
initializePagingArea
	"initialize the receiver's pagingArea"

	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: 'jmv 5/28/2006 14:47'!
initializeUpButton
	"initialize the receiver's upButton"

	upButton := RectangleMorph 
						newBounds: ((menuButton ifNil: [self innerBounds topLeft]
								ifNotNil: 
									[bounds isWide 
										ifTrue: [menuButton bounds topRight]
										ifFalse: [menuButton bounds bottomLeft]]) 
									extent: self buttonExtent).
	upButton color: self thumbColor.
	upButton 
		on: #mouseDown
		send: #scrollUpInit
		to: self.
	upButton 
		on: #mouseUp
		send: #finishedScrolling
		to: self.
	self updateUpButtonImage.
	upButton setBorderWidth: 1 borderColor: #raised.
	self addMorph: upButton! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 1/15/2005 20:23'!
updateDownButtonImage
	"update the receiver's downButton.  put a new image inside"

	downButton removeAllMorphs.
	downButton addMorphCentered: (ImageMorph new image: self downImage)! !

!ScrollBar methodsFor: 'initialize' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20:23'!
updateUpButtonImage
	"update the receiver's upButton. put a new image inside"

	upButton removeAllMorphs.
	upButton addMorphCentered: (ImageMorph new image: self upImage)! !


!ScrollBar class methodsFor: 'images' stamp: 'jmv 10/29/2006 14:36'!
createArrowOfDirection: aSymbol in: aRectangle 
	"PRIVATE - create an arrow bounded in aRectangle"

	| arrow vertices |
	vertices := self verticesForSimpleArrow: aRectangle.
	arrow := PolygonMorph 
				vertices: vertices
				color: Color transparent
				borderWidth: 0
				borderColor: Color black.
	arrow bounds: (arrow bounds insetBy: (aRectangle width / 6) rounded).
	aSymbol == #right 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 90].
	aSymbol == #bottom 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 180].
	aSymbol == #left 
		ifTrue: [arrow rotationDegrees: arrow rotationDegrees + 270].
	^arrow! !

!ScrollBar class methodsFor: 'images' stamp: 'jmv 8/26/2008 12:30'!
createArrowOfDirection: aSymbolDirection size: finalSizeInteger color: aColor 
	"PRIVATE - create an arrow with aSymbolDirectionDirection,  
	finalSizeInteger and aColor  
	 
	aSymbolDirectionDirection = #top, #bottom. #left or #right  
	 
	Try with:  
	(ScrollBar createArrowOfDirection: #top size: 32 color: Color  
	lightGreen) asMorph openInHand.  
	"

	| resizeFactor outerBox arrow resizedForm |
	resizeFactor := 4.
	outerBox := RectangleMorph new.
	outerBox
		extent: finalSizeInteger asPoint * resizeFactor;
		borderWidth: 0;
		color: aColor.
	""
	arrow := self createArrowOfDirection: aSymbolDirection in: outerBox bounds.
	arrow color: aColor muchDarker.
	outerBox addMorphCentered: arrow.
	""
	resizedForm := outerBox imageForm 
				magnify: outerBox imageForm boundingBox
				by: 1 / resizeFactor
				smoothing: 4.
	""
	^(resizedForm replaceColor: aColor withColor: Color transparent) 
		trimBordersOfColor: Color transparent! !

!ScrollBar class methodsFor: 'images' stamp: 'jmv 1/15/2005 20:23'!
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' stamp: 'jmv 8/26/2008 12:30'!
createBoxOfSize: finalSizeInteger color: aColor 
	"PRIVATE - create a box with finalSizeInteger and aColor  
	 
	Try with:  
	(ScrollBar createBoxOfSize: 32 color: Color lightGreen) asMorph  
	openInHand.  
	"

	| resizeFactor outerBox innerBox resizedForm |
	resizeFactor := 4.
	outerBox := RectangleMorph new.
	outerBox
		extent: finalSizeInteger asPoint * resizeFactor;
		borderWidth: 0;
		color: aColor.
	""
	innerBox := self createBoxIn: outerBox bounds.
	innerBox color: aColor muchDarker.
	outerBox addMorphCentered: innerBox.
	""
	resizedForm := outerBox imageForm 
				magnify: outerBox imageForm boundingBox
				by: 1 / resizeFactor
				smoothing: 4.
	""
	^(resizedForm replaceColor: aColor withColor: Color transparent) 
		trimBordersOfColor: Color transparent! !

!ScrollBar class methodsFor: 'images - samples' stamp: 'jmv 1/15/2005 20:35'!
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! !


!StarMorph methodsFor: 'editing' stamp: 'jmv 1/15/2005 20:11'!
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! !


!StrikeFont class methodsFor: 'instance creation' stamp: 'jmv 4/23/2007 23:33'!
fromUser: priorFont 
	"rr 3/23/2004 10:02 : made the menu invoked modally, thus allowing
	keyboard control"

	"StrikeFont fromUser"

	"Present a menu of available fonts, and if one is chosen, return it.
	Otherwise return nil."

	| fontList fontMenu style active ptMenu label spec font |
	fontList := StrikeFont actualFamilyNames.
	fontMenu := MenuMorph new defaultTarget: self.
	fontList do: 
			[:fontName | 
			style := TextStyle named: fontName.
			active := priorFont familyName sameAs: fontName.
			ptMenu := MenuMorph new defaultTarget: self.
			style pointSizes do: 
					[:pt | 
					(active and: [pt = priorFont pointSize]) 
						ifTrue: [label := '<on>']
						ifFalse: [label := '<off>'].
					label := label , pt printString , ' pt'.
					ptMenu 
						add: label
						target: fontMenu
						selector: #modalSelection:
						argument: { 
								fontName.
								pt}].
			active ifTrue: [label := '<on>'] ifFalse: [label := '<off>'].
			label := label , fontName.
			fontMenu add: label subMenu: ptMenu].
	spec := fontMenu invokeModal.
	spec ifNil: [^nil].
	style := TextStyle named: spec first.
	style ifNil: [^self].
	font := style fonts detect: [:any | any pointSize = spec last]
				ifNone: [nil].
	^font! !


!String methodsFor: 'converting' stamp: 'jmv 1/15/2005 20:24'!
asMorph
	"Answer the receiver as a StringMorph"

	^StringMorph contents: self

	"'bugs black blood' asMorph openInHand"! !


!StringHolder methodsFor: 'initialize-release' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 2/12/2008 19:20'!
offerMenuFrom: menuRetriever shifted: aBoolean 
	"Pop up, in morphic or mvc as the case may be, 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."

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


!CodeHolder methodsFor: 'annotation' stamp: 'jmv 1/15/2005 20:38'!
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: 'commands' stamp: 'jmv 3/27/2009 09:56'!
copyUpOrCopyDown
	"Used to copy down code from a superclass to a subclass or vice-versa in one easy step, if you know what you're doing.  Prompt the user for which class to copy down or copy up to, then spawn a fresh browser for that class, with the existing code planted in it, and with the existing method category also established."

	| aClass aSelector allClasses implementors aMenu aColor |
	((aClass := self selectedClassOrMetaClass) isNil 
		or: [(aSelector := self selectedMessageName) == nil]) 
			ifTrue: [^Beeper beep].
	allClasses := Utilities hierarchyOfClassesSurrounding: aClass.
	implementors := Smalltalk hierarchyOfImplementorsOf: aSelector
				forClass: aClass.
	aMenu := MenuMorph new defaultTarget: self.
	aMenu title: aClass name , '.' , aSelector 
				, '
Choose where to insert a copy of this method
(blue = current, black = available, red = other implementors'.
	allClasses do: 
			[:cl | 
			aColor := cl == aClass 
						ifTrue: [#blue]
						ifFalse: [(implementors includes: cl) ifTrue: [#red] ifFalse: [#black]].
			aColor == #red 
				ifFalse: 
					[aMenu 
						add: cl name
						selector: #spawnToClass:
						argument: cl]
				ifTrue: 
					[aMenu 
						add: cl name
						selector: #spawnToCollidingClass:
						argument: cl].
			aMenu lastItem color: (Color colorFrom: aColor)].
	aMenu popUpInWorld! !

!CodeHolder methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:39'!
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: 'construction' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:34'!
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: 'controls' stamp: 'jmv 5/28/2006 14:41'!
codePaneProvenanceButton
	"Answer a button that reports on, and allow the user to modify, the code-pane-provenance setting"

	| aButton |
	aButton := UpdatingSimpleButtonMorph newWithLabel: 'source'.
	aButton setNameTo: 'codeProvenance'.
	aButton
		target: self;
		wordingSelector: #codePaneProvenanceString;
		actionSelector: #offerWhatToShowMenu.
	aButton 
		setBalloonText: 'Governs what view is shown in the code pane.  Click here to change the view'.
	aButton actWhen: #buttonDown.
	aButton beTransparent.
	aButton borderColor: Color black.
	^aButton! !

!CodeHolder methodsFor: 'controls' stamp: 'jmv 5/28/2006 14:38'!
optionalButtonRow
	"Answer a row of control buttons"

	| aRow aButton aLabel |
	aRow := AlignmentMorph newRow.
	aRow setNameTo: 'buttonPane'.
	aRow beSticky.
	aRow hResizing: #spaceFill.
	aRow
		wrapCentering: #center;
		cellPositioning: #leftCenter.
	aRow clipSubmorphs: true.
	aRow cellInset: 3.
	Preferences menuButtonInToolPane 
		ifTrue: [aRow addMorphFront: self menuButton].
	self optionalButtonPairs do: 
			[:tuple | 
			aButton := PluggableButtonMorph 
						on: self
						getState: nil
						action: tuple second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				onColor: Color transparent offColor: Color transparent.
			aLabel := Preferences abbreviatedBrowserButtons 
						ifTrue: [self abbreviatedWordingFor: tuple second]
						ifFalse: [nil].
			aButton label: (aLabel ifNil: [tuple first asString]).
			" font: (StrikeFont familyName: 'Atlanta' size: 9)"
			tuple size > 2 ifTrue: [aButton setBalloonText: tuple third].
			tuple size > 3 ifTrue: [aButton triggerOnMouseDown: tuple fourth].
			aRow addMorphBack: aButton].
	aRow addMorphBack: self codePaneProvenanceButton.
	^aRow! !

!CodeHolder methodsFor: 'diffs' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 2/12/2008 18:58'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 2/12/2008 19:59'!
couldBrowseAnyClass
	"Answer whether the receiver is equipped to browse any class. This is in support of the system-brower feature that allows the browser to be redirected at the selected class name.  This implementation is clearly ugly, but the feature it enables is handsome enough.  3/1/96 sw"

	self dependents detect: 
			[:d | 
			(d isKindOf: PluggableListMorph) 
				and: [d getListSelector == #systemCategoryList]]
		ifNone: [^false].
	^true! !

!Browser methodsFor: 'class comment pane' stamp: 'jmv 1/15/2005 20:34'!
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: 'drag and drop' stamp: 'jmv 1/15/2005 20:34'!
codeTextMorph
	^self dependents detect: 
			[:dep | 
			(dep isKindOf: PluggableTextMorph) 
				and: [dep getTextSelector == #contents]]
		ifNone: []! !

!Browser methodsFor: 'drag and drop' stamp: 'jmv 1/15/2005 20:34'!
dragTransferTypeForMorph: dragSource 
	^(dragSource isKindOf: PluggableListMorph) 
		ifTrue: [dragSource getListSelector]! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 3/18/2009 21:57'!
addAListPane: aListPane to: window at: nominalFractions plus: verticalOffset 
	| row switchHeight divider |
	row := (AlignmentMorph newColumn)
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				layoutInset: 0;
				borderWidth: 1;
				layoutPolicy: ProportionalLayout new.
	switchHeight := Preferences standardDefaultTextFont height + 4.
	self addMorphicSwitchesTo: row
		at: (LayoutFrame fractions: (0 @ 1 corner: 1 @ 1)
				offsets: (0 @ (1 - switchHeight) corner: 0 @ 0)).
	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 @ switchHeight negated corner: 0 @ (1 - switchHeight))).
	row addMorph: aListPane
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ 0 corner: 0 @ switchHeight negated)).
	window addMorph: row
		fullFrame: (LayoutFrame fractions: nominalFractions
				offsets: (0 @ verticalOffset corner: 0 @ 0)).
	row 
		on: #mouseEnter
		send: #paneTransition:
		to: window.
	row 
		on: #mouseLeave
		send: #paneTransition:
		to: window! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2006 23:43'!
buildMorphicClassList
	| myClassList |
	(myClassList := PluggableListMorph new)
		setProperty: #highlightSelector toValue: #highlightClassList:with:;
		on: self
			list: #classList
			selected: #classListIndex
			changeSelected: #classListIndex:
			menu: #classListMenu:shifted:
			keystroke: #classListKey:from:.
	myClassList borderWidth: 0.
	myClassList enableDragNDrop: false.
	myClassList doubleClickSelector: #browseSelectionInPlace.
	^myClassList! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2006 23:44'!
buildMorphicMessageCatList
	| myMessageCatList |
	(myMessageCatList := PluggableMessageCategoryListMorph new)
		setProperty: #highlightSelector
			toValue: #highlightMessageCategoryList:with:;
		on: self
			list: #messageCategoryList
			selected: #messageCategoryListIndex
			changeSelected: #messageCategoryListIndex:
			menu: #messageCategoryMenu:
			keystroke: #arrowKey:from:
			getRawListSelector: #rawMessageCategoryList.
	myMessageCatList enableDragNDrop: false.
	^myMessageCatList! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2006 23:44'!
buildMorphicMessageList
	"Build a morphic message list, with #messageList as its list-getter"

	| aListMorph |
	(aListMorph := PluggableListMorph new)
		setProperty: #highlightSelector toValue: #highlightMessageList:with:;
		on: self
			list: #messageList
			selected: #messageListIndex
			changeSelected: #messageListIndex:
			menu: #messageListMenu:shifted:
			keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: false.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	^aListMorph! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 3/18/2009 21:41'!
buildMorphicSwitches
	| instanceSwitch divider1 divider2 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.
	divider1 := BorderedSubpaneDividerMorph vertical.
	divider2 := BorderedSubpaneDividerMorph vertical.
	Preferences alternativeWindowLook 
		ifTrue: 
			[divider1
				extent: 4 @ 4;
				borderWidth: 2;
				borderRaised;
				color: Color transparent.
			divider2
				extent: 4 @ 4;
				borderWidth: 2;
				borderRaised;
				color: Color transparent].
	row := (AlignmentMorph newRow)
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				layoutInset: 0;
				borderWidth: 0;
				addMorphBack: instanceSwitch;
				addMorphBack: divider1;
				addMorphBack: commentSwitch;
				addMorphBack: divider2;
				addMorphBack: classSwitch.
	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;
					hResizing: #spaceFill;
					vResizing: #spaceFill].
	^row! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2006 23:45'!
buildMorphicSystemCatList
	| dragNDropFlag myCatList |
	dragNDropFlag := false.
	(myCatList := PluggableListMorph new)
		setProperty: #highlightSelector toValue: #highlightSystemCategoryList:with:;
		on: self
			list: #systemCategoryList
			selected: #systemCategoryListIndex
			changeSelected: #systemCategoryListIndex:
			menu: #systemCategoryMenu:
			keystroke: #systemCatListKey:from:.
	myCatList enableDragNDrop: dragNDropFlag.
	^myCatList! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 3/18/2009 21:49'!
openAsMorphClassEditing: editString 
	"Create a pluggable version a Browser on just a single class."

	| window dragNDropFlag hSepFrac switchHeight mySingletonClassList |
	window := (SystemWindow labelled: 'later') model: self.
	dragNDropFlag := false.
	hSepFrac := 0.3.
	switchHeight := Preferences standardCodeFont height + 4.
	mySingletonClassList := PluggableListMorph 
				on: self
				list: #classListSingleton
				selected: #indexIsOne
				changeSelected: #indexIsOne:
				menu: #classListMenu:shifted:
				keystroke: #classListKey:from:.
	mySingletonClassList enableDragNDrop: dragNDropFlag.
	self 
		addLowerPanesTo: window
		at: (0 @ hSepFrac corner: 1 @ 1)
		with: editString.
	window addMorph: mySingletonClassList
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 0.5 @ 0)
				offsets: (0 @ 0 corner: 0 @ switchHeight)).
	self addMorphicSwitchesTo: window
		at: (LayoutFrame fractions: (0.5 @ 0 corner: 1.0 @ 0)
				offsets: (0 @ 0 corner: 0 @ switchHeight)).
	window addMorph: self buildMorphicMessageCatList
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 0.5 @ hSepFrac)
				offsets: (0 @ switchHeight corner: 0 @ 0)).
	window addMorph: self buildMorphicMessageList
		fullFrame: (LayoutFrame fractions: (0.5 @ 0 corner: 1.0 @ hSepFrac)
				offsets: (0 @ switchHeight corner: 0 @ 0)).
	window setUpdatablePanesFrom: #(#messageCategoryList #messageList).
	^window! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/24/2006 21:54'!
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: 'initialize-release' stamp: 'jmv 5/28/2006 23:46'!
openAsMorphMessageEditing: editString 
	"Create a pluggable version a Browser that shows just one message"

	| window mySingletonMessageList verticalOffset nominalFractions |
	window := (SystemWindow labelled: 'later') model: self.
	mySingletonMessageList := PluggableListMorph 
				on: self
				list: #messageListSingleton
				selected: #indexIsOne
				changeSelected: #indexIsOne:
				menu: #messageListMenu:shifted:
				keystroke: #messageListKey:from:.
	mySingletonMessageList enableDragNDrop: false.
	verticalOffset := 25.
	nominalFractions := 0 @ 0 corner: 1 @ 0.
	window addMorph: mySingletonMessageList
		fullFrame: (LayoutFrame fractions: nominalFractions
				offsets: (0 @ 0 corner: 0 @ verticalOffset)).
	verticalOffset := self 
				addOptionalAnnotationsTo: window
				at: nominalFractions
				plus: verticalOffset.
	verticalOffset := self 
				addOptionalButtonsTo: window
				at: nominalFractions
				plus: verticalOffset.
	window addMorph: (self buildMorphicCodePaneWith: editString)
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 1)
				offsets: (0 @ verticalOffset corner: 0 @ 0)).
	^window! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 5/28/2006 23:45'!
openAsMorphMsgCatEditing: editString 
	"Create a pluggable version a Browser on just a message category."

	| window hSepFrac |
	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.3.
	window 
		addMorph: ((PluggableListMorph 
				on: self
				list: #messageCatListSingleton
				selected: #indexIsOne
				changeSelected: #indexIsOne:
				menu: #messageCategoryMenu:) 
					enableDragNDrop: false)
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ 0 corner: 0 @ 25)).
	window addMorph: self buildMorphicMessageList
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ hSepFrac)
				offsets: (0 @ 25 corner: 0 @ 0)).
	self 
		addLowerPanesTo: window
		at: (0 @ hSepFrac corner: 1 @ 1)
		with: editString.
	window setUpdatablePanesFrom: #(#messageCatListSingleton #messageList).
	^window! !

!Browser methodsFor: 'initialize-release' stamp: 'jmv 3/18/2009 21:50'!
openAsMorphSysCatEditing: editString 
	"Create a pluggable version of all the views for a Browser, including views and controllers."

	| window hSepFrac switchHeight mySingletonList nextOffsets |
	window := (SystemWindow labelled: 'later') model: self.
	hSepFrac := 0.3.
	switchHeight := Preferences standardCodeFont height + 4.
	mySingletonList := PluggableListMorph 
				on: self
				list: #systemCategorySingleton
				selected: #indexIsOne
				changeSelected: #indexIsOne:
				menu: #systemCatSingletonMenu:
				keystroke: #systemCatSingletonKey:from:.
	mySingletonList enableDragNDrop: false.
	mySingletonList hideScrollBarsIndefinitely.
	window addMorph: mySingletonList
		fullFrame: (LayoutFrame fractions: (0 @ 0 corner: 1 @ 0)
				offsets: (0 @ 0 corner: 0 @ switchHeight)).
	self 
		addClassAndSwitchesTo: window
		at: (0 @ 0 corner: 0.3333 @ hSepFrac)
		plus: switchHeight.
	nextOffsets := 0 @ switchHeight corner: 0 @ 0.
	window addMorph: self buildMorphicMessageCatList
		fullFrame: (LayoutFrame 
				fractions: (0.3333 @ 0 corner: 0.6666 @ hSepFrac)
				offsets: nextOffsets).
	window addMorph: self buildMorphicMessageList
		fullFrame: (LayoutFrame fractions: (0.6666 @ 0 corner: 1 @ hSepFrac)
				offsets: nextOffsets).
	self 
		addLowerPanesTo: window
		at: (0 @ hSepFrac corner: 1 @ 1)
		with: editString.
	window 
		setUpdatablePanesFrom: #(#classList #messageCategoryList #messageList).
	^window! !

!Browser methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:38'!
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! !


!ChangeList methodsFor: 'initialization-release' stamp: 'jmv 3/31/2009 08:43'!
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: 'jmv 1/15/2005 20:35'!
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! !

!ChangeList methodsFor: 'menu actions' stamp: 'jmv 5/28/2006 14:38'!
optionalButtonRow
	"Answer a row of buttons to occur in a tool pane"

	| aRow aButton |
	aRow := AlignmentMorph newRow.
	aRow hResizing: #spaceFill.
	aRow clipSubmorphs: true.
	aRow
		layoutInset: 5 @ 2;
		cellInset: 3.
	aRow
		wrapCentering: #center;
		cellPositioning: #leftCenter.
	self changeListButtonSpecs do: 
			[:triplet | 
			aButton := PluggableButtonMorph 
						on: self
						getState: nil
						action: triplet second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				label: triplet first asString;
				askBeforeChanging: true;
				onColor: Color transparent offColor: Color transparent.
			aRow addMorphBack: aButton.
			aButton setBalloonText: triplet third].
	aRow addMorphBack: self regularDiffButton.
	self wantsPrettyDiffOption 
		ifTrue: [aRow addMorphBack: self prettyDiffButton].
	^aRow! !


!ChangeSorter methodsFor: 'creation' stamp: 'jmv 1/15/2005 20:16'!
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: 'jmv 5/24/2006 21:54'!
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: 'changeSet menu' stamp: 'jmv 3/27/2009 09:56'!
setRecentUpdatesMarker
	"Allow the user to change the recent-updates marker"

	| result |
	result := FillInTheBlank 
				request: 'Enter the lowest change-set number
that you wish to consider "recent"?
(note: highest change-set number
in this image at this time is ' 
						, self class highestNumberedChangeSet asString , ')'
				initialAnswer: self class recentUpdateMarker asString.
	(result notNil and: [result startsWithDigit]) 
		ifTrue: 
			[self class recentUpdateMarker: result asInteger.
			SystemWindow wakeUpTopWindowUponStartup]! !


!ChangeSetBrowser methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:35'!
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! !


!ChangeSorter class methodsFor: 'services' stamp: 'jmv 2/12/2008 18:56'!
reorderChangeSets
	"Change the order of the change sets to something more convenient:
		Next come all numbered updates.
		Next come all remaining changesets
	In a ChangeSorter, they will appear in the reversed order."

	"ChangeSorter reorderChangeSets"

	| newHead newMid newTail |
	newHead := OrderedCollection new.
	newMid := OrderedCollection new.
	newTail := OrderedCollection new.
	AllChangeSets do: 
			[:aChangeSet | 
					(self belongsInNumbered: aChangeSet) 
						ifTrue: [newMid add: aChangeSet]
						ifFalse: [newTail add: aChangeSet]].
	AllChangeSets := newHead , newMid , newTail.
	SystemWindow wakeUpTopWindowUponStartup! !


!Debugger methodsFor: 'initialize' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 5/28/2006 14:38'!
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"

	| aRow aButton aLabel |
	aRow := AlignmentMorph newRow beSticky.
	aRow setNameTo: 'customButtonPane'.
	aRow clipSubmorphs: true.
	aButton := SimpleButtonMorph new target: self.
	aButton
		color: Color lightRed;
		borderWidth: 1;
		borderColor: Color red darker.
	aRow addTransparentSpacerOfSize: 5 @ 0.
	self customButtonSpecs do: 
			[:tuple | 
			aButton := PluggableButtonMorph 
						on: self
						getState: nil
						action: tuple second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				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].
			aRow addMorphBack: aButton.
			aRow addTransparentSpacerOfSize: 3 @ 0].
	^aRow! !

!Debugger methodsFor: 'initialize' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 5/28/2006 14:38'!
optionalButtonRow
	"Answer a button pane affording the user one-touch access to certain functions; the pane is given the formal name 'buttonPane' by which it can be retrieved by code wishing to send messages to widgets residing on the pane"

	| aRow aButton aLabel |
	aRow := AlignmentMorph newRow beSticky.
	aRow setNameTo: 'buttonPane'.
	aRow clipSubmorphs: true.
	aButton := SimpleButtonMorph new target: self.
	aButton
		color: Color lightRed;
		borderWidth: 1;
		borderColor: Color red darker.
	aRow addTransparentSpacerOfSize: 5 @ 0.
	self optionalButtonPairs do: 
			[:tuple | 
			aButton := PluggableButtonMorph 
						on: self
						getState: nil
						action: tuple second.
			aButton
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				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].
			aRow addMorphBack: aButton.
			aRow addTransparentSpacerOfSize: 3 @ 0].
	^aRow! !

!Debugger methodsFor: 'context stack menu' stamp: 'jmv 3/18/2009 22:12'!
buildMorphicNotifierLabelled: label message: messageString 
	| notifyPane window contentTop extentToUse |
	self expandStack.
	window := (PreDebugWindow labelled: label) model: self.
	contentTop := 0.2.
	extentToUse := 650 @ 320.	"nice and wide to show plenty of the error msg"
	window addMorph: (self buttonRowForPreDebugWindow: window)
		frame: (0 @ 0 corner: 1 @ contentTop).
	messageString notNil 
		ifFalse: 
			[notifyPane := PluggableListMorph 
						on: self
						list: #contextStackList
						selected: #contextStackIndex
						changeSelected: #debugAt:
						menu: nil
						keystroke: nil]
		ifTrue: 
			[notifyPane := PluggableTextMorph 
						on: self
						text: nil
						accept: nil
						readSelection: nil
						menu: #debugProceedMenu:.
			notifyPane
				editString: (self preDebugNotifierContentsFrom: messageString);
				askBeforeDiscardingEdits: false].
	window addMorph: notifyPane frame: (0 @ contentTop corner: 1 @ 1).
	"window deleteCloseBox.
		chickened out by commenting the above line out, sw 8/14/2000 12:54"
	window setBalloonTextForCloseBox.
	^window openInWorldExtent: extentToUse! !

!Debugger methodsFor: 'context stack menu' stamp: 'jmv 3/27/2009 09:56'!
contextStackMenu: aMenu shifted: shifted 
	"Set up the menu appropriately for the context-stack-list, either shifted or unshifted as per the parameter provided"

	^shifted 
		ifFalse: 
			[self selectedContext selector = #doesNotUnderstand: 
				ifTrue: 
					[aMenu 
						add: 'implement in...'
						subMenu: (self populateImplementInMenu: (MenuMorph new defaultTarget: self))
						target: nil
						selector: nil
						argumentList: #(nil)].
			aMenu 
				labels: 'fullStack (f)
restart (r)
proceed (p)
step (t)
step through (T)
send (e)
where (w)
peel to first like this
toggle break on entry
senders of... (n)
implementors of... (m)
inheritance (i)
versions (v)
inst var refs...
inst var defs...
class var refs...
class variables
class refs (N)
browse full (b)
file out 
more...'
				lines: #(8 9 13 15 18 21)
				selections: #(#fullStack #restart #proceed #doStep #stepIntoBlock #send #where #peelToFirst #toggleBreakOnEntry #browseSendersOfMessages #browseMessages #methodHierarchy #browseVersions #browseInstVarRefs #browseInstVarDefs #browseClassVarRefs #browseClassVariables #browseClassRefs #browseMethodFull #fileOutMessage #shiftedYellowButtonActivity)]
		ifTrue: 
			[aMenu 
				labels: 'browse class hierarchy
browse class
browse method (O)
implementors of sent messages
change sets with this method
inspect instances
inspect subinstances
revert to previous version
remove from current change set
revert & remove from changes
more...'
				lines: #(5 7 10)
				selections: #(#classHierarchy #browseClass #openSingleMessageBrowser #browseAllMessages #findMethodInChangeSets #inspectInstances #inspectSubInstances #revertToPreviousVersion #removeFromCurrentChanges #revertAndForget #unshiftedYellowButtonActivity)]! !

!Debugger methodsFor: 'controls' stamp: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:34'!
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: 'initialization' stamp: 'jmv 1/15/2005 20:22'!
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: 
			[:service | 
			"just the three sort-by items"

			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: 'jmv 3/18/2009 22:07'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 3/18/2009 22:09'!
openAsMorph
	"Open a morphic view of a FileList on the default directory."

	| dir aFileList window upperFraction offset |
	dir := FileDirectory default.
	aFileList := self new directory: dir.
	window := (SystemWindow labelled: dir pathName) model: aFileList.
	upperFraction := 0.3.
	offset := 0.
	self 
		addVolumesAndPatternPanesTo: window
		at: (0 @ 0 corner: 0.3 @ upperFraction)
		plus: offset
		forFileList: aFileList.
	self 
		addButtonsAndFileListPanesTo: window
		at: (0.3 @ 0 corner: 1.0 @ upperFraction)
		plus: offset
		forFileList: aFileList.
	window addMorph: (PluggableTextMorph 
				on: aFileList
				text: #contents
				accept: #put:
				readSelection: #contentsSelection
				menu: #fileContentsMenu:shifted:)
		frame: (0 @ 0.3 corner: 1 @ 1).
	^window openInWorld! !

!FileList class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20: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: 'jmv 1/15/2005 20:35'!
isDirectoryList: aMorph 
	^aMorph isKindOf: SimpleHierarchicalListMorph! !

!FileList2 methodsFor: 'user interface' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:34'!
morphicFileContentsPane
	^PluggableTextMorph 
		on: self
		text: #contents
		accept: #put:
		readSelection: #contentsSelection
		menu: #fileContentsMenu:shifted:! !

!FileList2 methodsFor: 'user interface' stamp: 'jmv 1/15/2005 20:34'!
morphicFileListPane
	^(PluggableListMorph 
		on: self
		list: #fileList
		selected: #fileListIndex
		changeSelected: #fileListIndex:
		menu: #fileListMenu:)
		enableDrag: true;
		enableDrop: false;
		yourself! !

!FileList2 methodsFor: 'user interface' stamp: 'jmv 1/15/2005 20:34'!
morphicPatternPane
	^PluggableTextMorph 
		on: self
		text: #pattern
		accept: #pattern:! !


!FileList2 class methodsFor: 'morphic ui' stamp: 'jmv 5/28/2006 14:38'!
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 := (BorderedMorph new)
				layoutPolicy: ProportionalLayout new;
				color: Color lightBlue;
				borderColor: Color blue;
				borderWidth: 4;
				layoutInset: 4;
				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 @ 0 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! !

!FileList2 class methodsFor: 'morphic ui' stamp: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:16'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:22'!
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 methodsFor: 'menu commands' stamp: 'jmv 12/8/2008 15:39'!
inspectElement
	"Create and schedule an Inspector on an element of the receiver's model's currently selected collection."

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


!Inspector class methodsFor: 'instance creation' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 5/28/2006 23:45'!
buildMorphicMessageList
	"Build my message-list object in morphic"

	| aListMorph |
	aListMorph := PluggableListMorph new.
	aListMorph
		setProperty: #highlightSelector toValue: #highlightMessageList:with:;
		setProperty: #itemConversionMethod toValue: #asStringOrText.
	aListMorph 
		on: self
		list: #messageList
		selected: #messageListIndex
		changeSelected: #messageListIndex:
		menu: #messageListMenu:shifted:
		keystroke: #messageListKey:from:.
	aListMorph enableDragNDrop: false.
	aListMorph menuTitleSelector: #messageListSelectorTitle.
	^aListMorph! !

!MessageSet methodsFor: 'private' stamp: 'jmv 1/15/2005 20:16'!
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! !

!MessageSet methodsFor: 'filtering' stamp: 'jmv 11/27/2008 12:43'!
filterMessageList
	"Allow the user to refine the list of messages."

	| aMenu evt |
	messageList size <= 1 
		ifTrue: [^self inform: 'this is not a propitious filtering situation'].

	"would like to get the evt coming in but thwarted by the setInvokingView: circumlocution"
	evt := self currentWorld activeHand lastEvent.
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addTitle: 'Filter by only showing...'.
	aMenu addStayUpItem.
	aMenu 
		addList: #(#('unsent messages' #filterToUnsentMessages 'filter to show only messages that have no senders') #- #('messages that send...' #filterToSendersOf 'filter to show only messages that send a selector I specify') #('messages that do not send...' #filterToNotSendersOf 'filter to show only messages that do not send a selector I specify') #- #('messages whose selector is...' #filterToImplementorsOf 'filter to show only messages with a given selector I specify') #('messages whose selector is NOT...' #filterToNotImplementorsOf 'filter to show only messages whose selector is NOT a seletor I specify') #- #('messages in current change set' #filterToCurrentChangeSet 'filter to show only messages that are in the current change set') #('messages not in current change set' #filterToNotCurrentChangeSet 'filter to show only messages that are not in the current change set') #- #('messages in any change set' #filterToAnyChangeSet 'filter to show only messages that occur in at least one change set') #('messages not in any change set' #filterToNotAnyChangeSet 'filter to show only messages that do not occur in any change set in the system') #- #('messages authored by me' #filterToCurrentAuthor 'filter to show only messages whose authoring stamp has my initials') #('messages not authored by me' #filterToNotCurrentAuthor 'filter to show only messages whose authoring stamp does not have my initials') #- #('messages logged in .changes file' #filterToMessagesInChangesFile 'filter to show only messages whose latest source code is logged in the .changes file') #('messages only in .sources file' #filterToMessagesInSourcesFile 'filter to show only messages whose latest source code is logged in the .sources file') #- #('messages with prior versions' #filterToMessagesWithPriorVersions 'filter to show only messages that have at least one prior version') #('messages without prior versions' #filterToMessagesWithoutPriorVersions 'filter to show only messages that have no prior versions') #- #('uncommented messages' #filterToUncommentedMethods 'filter to show only messages that do not have comments at the beginning') #('commented messages' #filterToCommentedMethods 'fileter to show only messages that have comments at the beginning') #- #('messages that...' #filterToMessagesThat 'let me type in a block taking a class and a selector, which will specify yea or nay concerning which elements should remain in the list')).
	aMenu popUpEvent: evt hand lastEvent in: evt hand world! !


!MessageNames methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:34'!
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: 'jmv 1/15/2005 20:34'!
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: 'jmv 11/6/2008 14:31'!
morphicWindow
	"Create a Browser that lets you type part of a selector, shows a list of selectors, shows the classes of the one you chose, and spawns a full browser on it.  Answer the window
	SelectorBrowser new open "

	| window typeInView selectorListView classListView |
	window := (SystemWindow labelled: 'later') model: self.
	window setStripeColorsFrom: self class windowColor.
	selectorIndex := classListIndex := 0.
	typeInView := PluggableTextMorph 
				on: self
				text: #contents
				accept: #contents:notifying:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:.
	typeInView acceptOnCR: true.
	typeInView hideScrollBarsIndefinitely.
	window addMorph: typeInView frame: (0 @ 0 corner: 0.5 @ 0.14).
	selectorListView := PluggableListMorph 
				on: self
				list: #messageList
				selected: #messageListIndex
				changeSelected: #messageListIndex:
				menu: #selectorMenu:
				keystroke: #messageListKey:from:.
	selectorListView menuTitleSelector: #selectorMenuTitle.
	window addMorph: selectorListView frame: (0 @ 0.14 corner: 0.5 @ 0.6).
	classListView := PluggableListMorph 
				on: self
				list: #classList
				selected: #classListIndex
				changeSelected: #classListIndex:
				menu: nil
				keystroke: #arrowKey:from:.
	classListView menuTitleSelector: #classListSelectorTitle.
	window addMorph: classListView frame: (0.5 @ 0 corner: 1 @ 0.6).
	window 
		addMorph: ((PluggableTextMorph 
				on: self
				text: #byExample
				accept: #byExample:
				readSelection: #contentsSelection
				menu: #codePaneMenu:shifted:) askBeforeDiscardingEdits: false)
		frame: (0 @ 0.6 corner: 1 @ 1).
	window setLabel: 'Method Finder'.
	^window! !


!StringMorph methodsFor: 'editing' stamp: 'jmv 11/6/2008 17:38'!
launchMiniEditor: evt 
	| textMorph |
	hasFocus := true.	"Really only means edit in progress for this morph"
	textMorph := StringMorphEditor new contentsAsIs: contents.
	textMorph beAllFont: self fontToUse.
	textMorph bounds: (self bounds expandBy: 0 @ 2).
	self addMorphFront: textMorph.
	evt hand newMouseFocus: textMorph.
	self flag: #arNote.	"Why???"
"
	evt hand newKeyboardFocus: textMorph."
	textMorph editor selectFrom: 1 to: textMorph paragraph text string size! !

!StringMorph methodsFor: 'halos and balloon help' stamp: 'jmv 1/15/2005 20: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: 'jmv 1/15/2005 20:40'!
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: 'jmv 1/15/2005 20:40'!
initialize
	"initialize the state of the receiver"

	super initialize.
	""
	self borderStyle: (SimpleBorder width: 1 color: Color white)! !


!MenuItemMorph methodsFor: 'accessing' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20: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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 3/13/2009 10:03'!
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: 'jmv 3/27/2009 09:57'!
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: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:24'!
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: 'jmv 1/15/2005 20:34'!
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: 'toDeprecate' stamp: 'jmv 2/14/2008 01:26'!
snapshot: save andQuit: quit embedded: embeddedFlag 
	"Mark the changes file and close all files as part of #processShutdownList.
	If save is true, save the current state of this Smalltalk in the image file.
	If quit is true, then exit to the outer OS shell.
	The latter part of this method runs when resuming a previously saved image. This resume logic checks for a document file to process when starting up."

	| resuming msg |
	Object flushDependents.
	Object flushEvents.
	(SourceFiles at: 2) ifNotNil: 
			[msg := String streamContents: 
							[:s | 
							s
								nextPutAll: '----';
								nextPutAll: (save 
											ifTrue: [quit ifTrue: ['QUIT'] ifFalse: ['SNAPSHOT']]
											ifFalse: [quit ifTrue: ['QUIT/NOSAVE'] ifFalse: ['NOP']]);
								nextPutAll: '----';
								print: Date dateAndTimeNow;
								space;
								nextPutAll: (FileDirectory default localNameFor: self imageName);
								nextPutAll: ' priorSource: ';
								print: LastQuitLogPosition].
			self assureStartupStampLogged.
			save 
				ifTrue: 
					[LastQuitLogPosition _ ((SourceFiles at: 2)
								setToEnd;
								position)].
			self logChange: msg.
			Transcript
				cr;
				show: msg].
	self processShutDownList: quit.
	Cursor write show.
	save 
		ifTrue: 
			[resuming := embeddedFlag 
						ifTrue: [self snapshotEmbeddedPrimitive]
						ifFalse: [self snapshotPrimitive].	"<-- PC frozen here on image file"
			resuming == false 
				ifTrue: 
					["guard against failure"

					"Time to reclaim segment files is immediately after a save"

					Smalltalk at: #ImageSegment
						ifPresent: [:theClass | theClass reclaimObsoleteSegmentFiles]]]
		ifFalse: [resuming := false].
	quit & (resuming == false) ifTrue: [self quitPrimitive].
	Cursor normal show.
	self setGCParameters.
	resuming == true ifTrue: [self clearExternalObjects].
	self processStartUpList: resuming == true.
	resuming == true 
		ifTrue: 
			[self setPlatformPreferences.
			self readDocumentFile].
	SystemWindow wakeUpTopWindowUponStartup.
	"Now it's time to raise an error"
	resuming == nil 
		ifTrue: [self error: 'Failed to write image file (disk full?)'].
	^resuming! !


!SystemWindow methodsFor: 'drawing' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 6/7/2007 18:45'!
addCloseBox
	"If I have a labelArea, add a close box to it"

	| frame |
	labelArea ifNil: [^self].
	closeBox := self createCloseBox.
	frame := LayoutFrame new.
	frame
		leftFraction: 0;
		leftOffset: 2;
		topFraction: 0;
		topOffset: 1.
	closeBox layoutFrame: frame.
	labelArea addMorph: closeBox! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 6/7/2007 18:45'!
addExpandBox
	"If I have a labelArea, add a close box to it"

	| frame |
	labelArea ifNil: [^self].
	expandBox := self createExpandBox.
	frame := LayoutFrame new.
	frame
		leftFraction: 1;
		leftOffset: (self boxExtent x * 2 + 3) negated;
		topFraction: 0;
		topOffset: 1.
	expandBox layoutFrame: frame.
	labelArea addMorph: expandBox! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:39'!
addLabelArea
	labelArea := (AlignmentMorph newSpacer: Color transparent)
				vResizing: #spaceFill;
				layoutPolicy: ProportionalLayout new.
	self addMorph: labelArea! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 6/7/2007 18:38'!
addMenuControl
	"If I have a label area, add a menu control to it."

	| frame |
	labelArea ifNil: [^self].
	"No menu if no label area"
	menuBox ifNotNil: [menuBox delete].
	menuBox := self createMenuBox.
	frame := LayoutFrame new.
	frame
		leftFraction: 0;
		leftOffset: closeBox right + 3;
		topFraction: 0;
		topOffset: 1.
	menuBox layoutFrame: frame.
	labelArea addMorph: menuBox! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 5/28/2006 14:39'!
createBox
	"create a button with default to be used in the label area"

	"Transcript show: self paneColor asString;  
	cr."

	| box boxBorderWidth |
	box := IconicButton new.
	box
		color: Color transparent;
		target: self.
	boxBorderWidth := (Preferences alternativeWindowLook 
				and: [Preferences alternativeWindowBoxesLook]) ifTrue: [1] ifFalse: [0].
	box borderWidth: boxBorderWidth.
	^box! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 5/27/2006 22:45'!
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 layoutPolicy: ProportionalLayout new.
	self wantsLabel ifTrue: [self initializeLabelArea].
	self 
		on: #mouseEnter
		send: #spawnReframeHandle:
		to: self.
	self 
		on: #mouseLeave
		send: #spawnReframeHandle:
		to: self.
	self extent: 300 @ 200.
	mustNotClose := false.
	updatablePanes := Array new! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 2/26/2009 13:40'!
initializeLabelArea
	"Initialize the label area (titlebar) for the window."

	label := (StringMorph new)
				contents: labelString;
				font: Preferences windowTitleFont.
	"Add collapse box so #labelHeight will work"
	collapseBox := self createCollapseBox.
	stripes := Array with: (RectangleMorph newBounds: bounds)
				with: (RectangleMorph newBounds: bounds).
	"see extent:"
	self addLabelArea.
	labelArea addMorph: (stripes first borderWidth: 1).
	labelArea addMorph: (stripes second borderWidth: 2).
	self setLabelWidgetAllowance.
	self addCloseBox.
	self addMenuControl.
	labelArea addMorph: label.
	self wantsExpandBox ifTrue: [self addExpandBox].
	labelArea addMorph: collapseBox.
	self setFramesForLabelArea.
	Preferences noviceMode 
		ifTrue: 
			[closeBox ifNotNil: [closeBox setBalloonText: 'close window' translated].
			menuBox ifNotNil: [menuBox setBalloonText: 'window menu' translated].
			collapseBox 
				ifNotNil: [collapseBox setBalloonText: 'collapse/expand window' translated]]! !

!SystemWindow methodsFor: 'initialization' stamp: 'jmv 6/7/2007 18:47'!
setFramesForLabelArea
	"an aid to converting old instances, but then I found  
	convertAlignment (jesse welton's note)"

	| frame |
	labelArea ifNil: [^self].
	frame := LayoutFrame new.
	frame
		leftFraction: 0.5;
		topFraction: 0.5;
		leftOffset: label width negated // 2;
		topOffset: label height negated // 2.
	label layoutFrame: frame.
	frame := LayoutFrame new.
	frame
		rightFraction: 1;
		topFraction: 0;
		rightOffset: -2;
		topOffset: 1.
	collapseBox ifNotNilDo: [:cb | cb layoutFrame: frame].
	stripes isEmptyOrNil 
		ifFalse: 
			[frame := LayoutFrame new.
			frame
				leftFraction: 0;
				topFraction: 0;
				rightFraction: 1;
				leftOffset: 1;
				topOffset: 1;
				rightOffset: -1;
				bottomOffset: -2.
			stripes first layoutFrame: frame.
			stripes first height: self labelHeight - 1.
			stripes first hResizing: #spaceFill.
			frame := LayoutFrame new.
			frame
				leftFraction: 0;
				topFraction: 0;
				rightFraction: 1;
				leftOffset: 3;
				topOffset: 3;
				rightOffset: -3.
			stripes last layoutFrame: frame.
			stripes last height: self labelHeight - 5.
			stripes last hResizing: #spaceFill].
	labelArea ifNotNil: 
			[frame := LayoutFrame fractions: (0 @ 0 corner: 1 @ 0)
						offsets: (1 @ self labelHeight negated - 1 corner: 0 @ 0).
			Preferences alternativeWindowLook ifTrue: [frame leftOffset: 0].
			labelArea layoutFrame: frame]! !

!SystemWindow methodsFor: 'label' stamp: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'jmv 5/24/2006 21:56'!
fullScreen
	"Zoom Window to Full World size with possible DeskMargins"

	"SystemWindow fullScreen"

	| left right possibleBounds |
	left := right := 0.
	self paneMorphs do: 
			[:pane | 
			((pane isKindOf: ScrollPane) and: [pane retractableScrollBar]) 
				ifTrue: [
					right := right max: pane scrollBarThickness]].
	possibleBounds := (RealEstateAgent maximumUsableAreaInWorld: self world) 
				insetBy: (left @ 0 corner: right @ 0).
	Preferences fullScreenLeavesDeskMargins 
		ifTrue: [possibleBounds := possibleBounds insetBy: 22].
	self bounds: possibleBounds! !

!SystemWindow methodsFor: 'menu' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:35'!
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: 'open/close' stamp: 'jmv 5/28/2006 10:58'!
delete
	| thisWorld |
	self mustNotClose ifTrue: [^self].
	model okToChange ifFalse: [^self].
	thisWorld := self world.
	super delete.
	model
		windowIsClosing;
		release.
	model := nil.
	SystemWindow noteTopWindowIn: thisWorld! !

!SystemWindow methodsFor: 'panes' stamp: 'jmv 1/15/2005 20:38'!
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: 'jmv 12/8/2008 15:42'!
holdsTranscript
	"ugh"

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

!SystemWindow methodsFor: 'panes' stamp: 'jmv 1/15/2005 20:34'!
setUpdatablePanesFrom: getSelectors 
	"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 aPane possibles |
	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: 'panes' stamp: 'jmv 12/8/2008 15:57'!
titleAndPaneText
	"If the receiver represents a workspace, return an Association between the title and that text, else return nil"

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

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 11/7/2008 13:23'!
spawnOffsetReframeHandle: event divider: divider 
	"The mouse has crossed a secondary (fixed-height) pane divider.  Spawn a reframe handle."

	"Only supports vertical adjustments."

	| siblings topAdjustees bottomAdjustees topOnly bottomOnly resizer pt delta minY maxY cursor |
	owner ifNil: [^self	"Spurious mouseLeave due to delete"].
	self isCollapsed ifTrue: [^self].
	((self world ifNil: [^self]) firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	divider layoutFrame ifNil: [^self].
	(#(#top #bottom) includes: divider resizingEdge) ifFalse: [^self].
	siblings := divider owner submorphs select: [:m | m layoutFrame notNil].
	divider resizingEdge = #bottom 
		ifTrue: 
			[cursor := Cursor resizeTop.
			topAdjustees := siblings select: 
							[:m | 
							m layoutFrame topFraction = divider layoutFrame bottomFraction 
								and: [m layoutFrame topOffset >= divider layoutFrame topOffset]].
			bottomAdjustees := siblings select: 
							[:m | 
							m layoutFrame bottomFraction = divider layoutFrame topFraction 
								and: [m layoutFrame bottomOffset >= divider layoutFrame topOffset]]].
	divider resizingEdge = #top 
		ifTrue: 
			[cursor := Cursor resizeBottom.
			topAdjustees := siblings select: 
							[:m | 
							m layoutFrame topFraction = divider layoutFrame bottomFraction 
								and: [m layoutFrame topOffset <= divider layoutFrame bottomOffset]].
			bottomAdjustees := siblings select: 
							[:m | 
							m layoutFrame bottomFraction = divider layoutFrame topFraction 
								and: [m layoutFrame bottomOffset <= divider layoutFrame bottomOffset]]].
	topOnly := topAdjustees copyWithoutAll: bottomAdjustees.
	bottomOnly := bottomAdjustees copyWithoutAll: topAdjustees.
	(topOnly isEmpty or: [bottomOnly isEmpty]) ifTrue: [^self].
	minY := bottomOnly inject: -9999
				into: [:y :m | y max: m top + (m minHeight max: 16) + (divider bottom - m bottom)].
	maxY := topOnly inject: 9999
				into: [:y :m | y min: m bottom - (m minHeight max: 16) - (m top - divider top)].
	pt := event cursorPoint.
	resizer := NewHandleMorph new 
				followHand: event hand
				forEachPointDo: 
					[:p | 
					delta := (p y min: maxY max: minY) - pt y.
					topAdjustees 
						do: [:m | m layoutFrame topOffset: m layoutFrame topOffset + delta].
					bottomAdjustees 
						do: [:m | m layoutFrame bottomOffset: m layoutFrame bottomOffset + delta].
					divider layoutChanged.
					pt := pt + delta]
				lastPointDo: [:p | ]
				withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !

!SystemWindow methodsFor: 'resize/collapse' stamp: 'jmv 1/15/2005 20:12'!
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: 'resize/collapse' stamp: 'jmv 11/7/2008 13:23'!
spawnReframeHandle: event 
	"The mouse has crossed a pane border.  Spawn a reframe handle."

	| resizer localPt pt ptName newBounds cursor |
	owner ifNil: [^self	"Spurious mouseLeave due to delete"].
	self isCollapsed ifTrue: [^self].
	((self world ifNil: [^self]) firstSubmorph isKindOf: NewHandleMorph) 
		ifTrue: [^self	"Prevent multiple handles"].
	pt := event cursorPoint.
	"prevent spurios mouse leave when dropping morphs"
	owner 
		morphsInFrontOf: self
		overlapping: (pt - 2 extent: 4 @ 4)
		do: [:m | m isHandMorph ifFalse: [(m fullContainsPoint: pt) ifTrue: [^self]]].
	self bounds forPoint: pt
		closestSideDistLen: 
			[:side :dist :len | 
			"Check for window side adjust"

			dist <= 2 ifTrue: [ptName := side]].
	ptName ifNil: 
			["Check for pane border adjust"

			^self spawnPaneFrameHandle: event].
	#(#topLeft #bottomRight #bottomLeft #topRight) do: 
			[:corner | 
			"Check for window corner adjust"

			(pt dist: (self bounds perform: corner)) < 20 ifTrue: [ptName := corner]].
	cursor := Cursor resizeForEdge: ptName.
	resizer := (NewHandleMorph new)
				sensorMode: self fastFramingOn;
				followHand: event hand
					forEachPointDo: 
						[:p | 
						localPt := self pointFromWorld: p.
						newBounds := self bounds 
									withSideOrCorner: ptName
									setToPoint: localPt
									minExtent: self minimumExtent.
						self fastFramingOn 
							ifTrue: 
								[Cursor currentCursor == cursor 
									ifFalse: 
										[(event hand)
											visible: false;
											refreshWorld;
											visible: true.
										cursor show].
								self doFastWindowReframe: ptName]
							ifFalse: 
								[self bounds: newBounds]]
					lastPointDo: [:p | ]
					withCursor: cursor.
	event hand world addMorphInLayer: resizer.
	resizer startStepping! !

!SystemWindow methodsFor: 'top window' stamp: 'jmv 11/7/2008 15:25'!
passivate
	"Make me unable to respond to mouse and keyboard"

	| focus |
	focus _ ActiveHand keyboardFocus.
	focus ifNotNil: [
		(focus ownerThatIsA: SystemWindow) == self
			ifTrue: [ ActiveHand releaseKeyboardFocus ]].

	self setStripeColorsFrom: self paneColorToUse.
	model modelSleep.

	labelArea ifNil: [ "i.e. label area is nil, so we're titleless"
		self adjustBorderUponDeactivationWhenLabeless].
	
	self world ifNotNil:  "clean damage now, so dont merge this rect with new top window"
		[self world == World ifTrue: [self world displayWorld]]! !


!PreDebugWindow methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:34'!
initialize
	| aFont proceedLabel debugLabel aWidth |
	super initialize.
	true 
		ifFalse: 
			["Preferences optionalMorphicButtons"

			(aWidth := self widthOfFullLabelText) > 280 ifTrue: [^self].	"No proceed/debug buttons if title too long"
			debugLabel := aWidth > 210 
						ifTrue: 
							["Abbreviated buttons if title pretty long"

							proceedLabel := 'p'.
							'd']
						ifFalse: 
							["Full buttons if title short enough"

							proceedLabel := 'proceed'.
							'debug'].
			aFont := Preferences standardButtonFont.
			self addMorph: (proceedButton := (SimpleButtonMorph new)
								borderWidth: 0;
								label: proceedLabel font: aFont;
								color: Color transparent;
								actionSelector: #proceed;
								target: self).
			proceedButton setBalloonText: 'continue execution'.
			self addMorph: (debugButton := (SimpleButtonMorph new)
								borderWidth: 0;
								label: debugLabel font: aFont;
								color: Color transparent;
								actionSelector: #debug;
								target: self).
			debugButton setBalloonText: 'bring up a debugger'.
			proceedButton submorphs first color: Color blue.
			debugButton submorphs first color: Color red].
	self adjustBookControls! !


!SystemWindow class methodsFor: 'new-morph participation' stamp: 'jmv 1/15/2005 20:16'!
includeInNewMorphMenu
	"Include my subclasses but not me"

	^self ~~ SystemWindow! !

!SystemWindow class methodsFor: 'top window' stamp: 'jmv 11/7/2008 13:10'!
noteTopWindowIn: aWorld
	| newTop |
	"TopWindow must be nil or point to the top window in this project."
	TopWindow _ nil.
	aWorld ifNil: [^ self].
	newTop _ aWorld findA: SystemWindow.
	newTop == nil ifFalse: [newTop activate]! !


!TableLayout methodsFor: 'layout' stamp: 'jmv 3/13/2009 10:23'!
computeCellArrangement: cellHolder in: newBounds horizontal: aBool target: aMorph
	"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."
	| cells wrap spacing output maxExtent n sum index max cell first last w cellMax maxCell hFill vFill inset |
	maxCell _ cellHolder key.
	cells _ cellHolder value.
	properties wrapDirection == #none 
		ifTrue:[wrap _ SmallInteger maxVal]
		ifFalse:[wrap _ aBool ifTrue:[newBounds width] ifFalse:[newBounds height].
				wrap < maxCell x ifTrue:[wrap _ maxCell x]].
	spacing _ properties cellSpacing.
	(spacing == #globalRect or:[spacing = #globalSquare]) ifTrue:[
		"Globally equal spacing is a very special case here, so get out fast and easy"
		^self computeGlobalCellArrangement: cells 
			in: newBounds horizontal: aBool 
			wrap: wrap spacing: spacing].

	output _ (WriteStream on: Array new).
	inset _ properties cellInset asPoint.
	aBool ifFalse:[inset _ inset transposed].
	first _ last _ nil.
	maxExtent _ 0@0.
	sum _ 0.
	index _ 1.
	n _ 0.
	hFill _ vFill _ false.
	[index <= cells size] whileTrue:[
		w _ sum.
		cell _ cells at: index.
		cellMax _ maxExtent max: cell cellSize. "e.g., minSize"
		(spacing == #localRect or:[spacing == #localSquare]) ifTrue:[
			"Recompute entire size of current row"
			spacing == #localSquare 
				ifTrue:[max _ cellMax x max: cellMax y]
				ifFalse:[max _ cellMax x].
			sum _ (n + 1) * max.
		] ifFalse:[
			sum _ sum + (cell cellSize x).
		].
		((sum + (n * inset x)) > wrap and:[first notNil]) ifTrue:[
			"It doesn't fit and we're not starting a new line"
			(spacing == #localSquare or:[spacing == #localRect]) ifTrue:[
				spacing == #localSquare 
					ifTrue:[maxExtent _ (maxExtent x max: maxExtent y) asPoint].
				first do:[:c| c cellSize: maxExtent]].
			w _ w + ((n - 1) * inset x).
			"redistribute extra space"
			first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]].
			last _ LayoutCell new.
			last cellSize: w @ (maxExtent y).
			last hSpaceFill: hFill.
			last vSpaceFill: vFill.
			last nextCell: first.
			output position = 0 ifFalse:[last addExtraSpace: 0@inset y].
			output nextPut: last.
			first _ nil.
			maxExtent _ 0@0.
			sum _ 0.
			n _ 0.
			hFill _ vFill _ false.
		] ifFalse:[
			"It did fit; use next item from input"
			first ifNil:[first _ last _ cell] ifNotNil:[last nextCell: cell. last _ cell].
			index _ index+1.
			n _ n + 1.
			maxExtent _ cellMax.
			hFill _ hFill or:[cell hSpaceFill].
			vFill _ vFill or:[cell vSpaceFill].
		].
	].
	first ifNotNil:[
		last _ LayoutCell new.
		sum _ sum + ((n - 1) * inset x).
		first nextCell ifNotNil:[first nextCell do:[:c| c addExtraSpace: inset x@0]].
		last cellSize: sum @ maxExtent y.
		last hSpaceFill: hFill.
		last vSpaceFill: vFill.
		last nextCell: first.
		output position = 0 ifFalse:[last addExtraSpace: 0@inset y].
		output nextPut: last].
	output _ output contents.
	properties listSpacing == #equal ifTrue:[
		"Make all the heights equal"
		max _ output inject: 0 into:[:size :c| size max: c cellSize y].
		output do:[:c| c cellSize: c cellSize x @ max].
	].
	^output! !

!TableLayout methodsFor: 'layout' stamp: 'jmv 1/15/2005 20:38'!
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: 'jmv 1/15/2005 20:38'!
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: 'optimized' stamp: 'jmv 3/13/2009 10:24'!
layoutLeftToRight: aMorph in: newBounds
	"An optimized left-to-right list layout"
	| inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props |
	size _ properties minCellSize asPoint. minX _ size x. minY _ size y.
	size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y.
	inset _ properties cellInset asPoint x.
	extent _ newBounds extent.
	n _ 0. vFill _ false. sum _ 0.
	width _ height _ 0.
	first _ last _ nil.
	block _ [:m|
		props _ m layoutProperties ifNil:[m].
		props disableTableLayout ifFalse:[
			n _ n + 1.
			cell _ LayoutCell new target: m.
			(props hResizing == #spaceFill) ifTrue:[
				cell hSpaceFill: true.
				extra _ m spaceFillWeight.
				cell extraSpace: extra.
				sum _ sum + extra.
			] ifFalse:[cell hSpaceFill: false].
			(props vResizing == #spaceFill) ifTrue:[vFill _ true].
			size _ m minExtent.
			size _ m minExtent. sizeX _ size x. sizeY _ size y.
			sizeX < minX
				ifTrue:[sizeX _ minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]].
			sizeY < minY
				ifTrue:[sizeY _ minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]].
			cell cellSize: sizeX.
			last ifNil:[first _ cell] ifNotNil:[last nextCell: cell].
			last _ cell.
			width _ width + sizeX.
			sizeY > height ifTrue:[height _ sizeY].
		].
	].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].

	n > 1 ifTrue:[width _ width + (n-1 * inset)].

	(properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]])
		ifTrue:[extent _ width @ (extent y max: height)].
	(properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]])
		ifTrue:[extent _ (extent x max: width) @ height].

	posX _ newBounds left.
	posY _ newBounds top.

	"Compute extra vertical space"
	extra _ extent y - height.
	extra < 0 ifTrue:[extra _ 0].
	extra > 0 ifTrue:[
		vFill ifTrue:[
			height _ extent y.
		] ifFalse:[
			centering _ properties wrapCentering.
			centering == #bottomRight ifTrue:[posY _ posY + extra].
			centering == #center ifTrue:[posY _ posY + (extra // 2)]
		].
	].


	"Compute extra horizontal space"
	extra _ extent x - width.
	extra < 0 ifTrue:[extra _ 0].
	extraPerCell _ 0.
	extra > 0 ifTrue:[
		sum isZero ifTrue:["extra space but no #spaceFillers"
			centering _ properties listCentering.
			centering == #bottomRight ifTrue:[posX _ posX + extra].
			centering == #center ifTrue:[posX _ posX + (extra // 2)].
		] ifFalse:[extraPerCell _ extra asFloat / sum asFloat].
	].

	n _ 0.
	extra _ last _ 0.
	cell _ first.
	[cell == nil] whileFalse:[
		n _ n + 1.
		width _ cell cellSize.
		(extraPerCell > 0 and:[cell hSpaceFill]) ifTrue:[
			extra _ (last _ extra) + (extraPerCell * cell extraSpace).
			amount _ extra truncated - last truncated.
			width _ width + amount.
		].
		cell target layoutInBounds: (posX @ posY extent: width @ height).
		posX _ posX + width + inset.
		cell _ cell nextCell.
	].
! !

!TableLayout methodsFor: 'optimized' stamp: 'jmv 3/13/2009 10:25'!
layoutTopToBottom: aMorph in: newBounds
	"An optimized top-to-bottom list layout"
	| inset n size extent width height block sum vFill posX posY extra centering extraPerCell last amount minX minY maxX maxY sizeX sizeY first cell props |
	size _ properties minCellSize asPoint. minX _ size x. minY _ size y.
	size _ properties maxCellSize asPoint. maxX _ size x. maxY _ size y.
	inset _ properties cellInset asPoint y.
	extent _ newBounds extent.
	n _ 0. vFill _ false. sum _ 0.
	width _ height _ 0.
	first _ last _ nil.
	block _ [:m|
		props _ m layoutProperties ifNil:[m].
		props disableTableLayout ifFalse:[
			n _ n + 1.
			cell _ LayoutCell new target: m.
			(props vResizing == #spaceFill) ifTrue:[
				cell vSpaceFill: true.
				extra _ m spaceFillWeight.
				cell extraSpace: extra.
				sum _ sum + extra.
			] ifFalse:[cell vSpaceFill: false].
			(props hResizing == #spaceFill) ifTrue:[vFill _ true].
			size _ m minExtent. sizeX _ size x. sizeY _ size y.
			sizeX < minX
				ifTrue:[sizeX _ minX]
				ifFalse:[sizeX > maxX ifTrue:[sizeX _ maxX]].
			sizeY < minY
				ifTrue:[sizeY _ minY]
				ifFalse:[sizeY > maxY ifTrue:[sizeY _ maxY]].
			cell cellSize: sizeY.
			first ifNil:[first _ cell] ifNotNil:[last nextCell: cell].
			last _ cell.
			height _ height + sizeY.
			sizeX > width ifTrue:[width _ sizeX].
		].
	].
	properties reverseTableCells
		ifTrue:[aMorph submorphsReverseDo: block]
		ifFalse:[aMorph submorphsDo: block].

	n > 1 ifTrue:[height _ height + (n-1 * inset)].

	(properties vResizing == #shrinkWrap and:[properties rubberBandCells or:[sum isZero]])
		ifTrue:[extent _ (extent x max: width) @ height].
	(properties hResizing == #shrinkWrap and:[properties rubberBandCells or:[vFill not]])
		ifTrue:[extent _ width @ (extent y max: height)].

	posX _ newBounds left.
	posY _ newBounds top.

	"Compute extra horizontal space"
	extra _ extent x - width.
	extra < 0 ifTrue:[extra _ 0].
	extra > 0 ifTrue:[
		vFill ifTrue:[
			width _ extent x.
		] ifFalse:[
			centering _ properties wrapCentering.
			centering == #bottomRight ifTrue:[posX _ posX + extra].
			centering == #center ifTrue:[posX _ posX + (extra // 2)]
		].
	].


	"Compute extra vertical space"
	extra _ extent y - height.
	extra < 0 ifTrue:[extra _ 0].
	extraPerCell _ 0.
	extra > 0 ifTrue:[
		sum isZero ifTrue:["extra space but no #spaceFillers"
			centering _ properties listCentering.
			centering == #bottomRight ifTrue:[posY _ posY + extra].
			centering == #center ifTrue:[posY _ posY + (extra // 2)].
		] ifFalse:[extraPerCell _ extra asFloat / sum asFloat].
	].

	n _ 0.
	extra _ last _ 0.
	cell _ first.
	[cell == nil] whileFalse:[
		n _ n + 1.
		height _ cell cellSize.
		(extraPerCell > 0 and:[cell vSpaceFill]) ifTrue:[
			extra _ (last _ extra) + (extraPerCell * cell extraSpace).
			amount _ extra truncated - last truncated.
			height _ height + amount.
		].
		cell target layoutInBounds: (posX @ posY extent: width @ height).
		posY _ posY + height + inset.
		cell _ cell nextCell.
	].! !


!TestRunner methodsFor: 'interface opening' stamp: 'jmv 1/15/2005 20:34'!
buildDetailsText
	detailsText := PluggableTextMorph 
				on: self
				text: #details
				accept: nil.
	detailsText hideScrollBarsIndefinitely.
	^detailsText! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 1/15/2005 20:34'!
buildErrorsList
	^PluggableListMorph 
		on: self
		list: #errorsList
		selected: #selectedErrorTest
		changeSelected: #debugErrorTest:! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 1/15/2005 20:34'!
buildFailuresList
	^PluggableListMorph 
		on: self
		list: #failuresList
		selected: #selectedFailureTest
		changeSelected: #debugFailureTest:! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2006 14:40'!
buildFilterButton
	| filterButton |
	filterButton := PluggableButtonMorph 
				on: self
				getState: nil
				action: #setFilter
				label: #filterButtonLabel.
	filterButton
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	filterButton onColor: self runButtonColor offColor: self runButtonColor.
	^filterButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:34'!
buildPassFailText
	passFailText := PluggableTextMorph 
				on: self
				text: #passFail
				accept: nil.
	passFailText hideScrollBarsIndefinitely.
	^passFailText! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2006 14:40'!
buildRefreshButton
	| refreshButton |
	refreshButton := PluggableButtonMorph 
				on: self
				getState: #refreshButtonState
				action: #refreshTests
				label: #refreshButtonLabel.
	refreshButton
		color: self runButtonColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	refreshButton onColor: self runButtonColor offColor: self runButtonColor.
	^refreshButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2006 14:40'!
buildRunButton
	| runButton |
	runButton := PluggableButtonMorph 
				on: self
				getState: #runButtonState
				action: #runTests
				label: #runButtonLabel.
	runButton
		color: self runButtonColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	runButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^runButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2006 14:40'!
buildRunOneButton
	| runOneButton |
	runOneButton := PluggableButtonMorph 
				on: self
				getState: #runButtonState
				action: #runOneTest
				label: #runOneButtonLabel.
	runOneButton
		color: self runButtonColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	runOneButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^runOneButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 5/28/2006 14:40'!
buildStopButton
	| stopButton |
	stopButton := PluggableButtonMorph 
				on: self
				getState: #stopButtonState
				action: #terminateRun
				label: #stopButtonLabel.
	stopButton
		color: self runButtonColor;
		hResizing: #spaceFill;
		vResizing: #spaceFill.
	stopButton onColor: self runButtonColor offColor: self runButtonOffColor.
	^stopButton! !

!TestRunner methodsFor: 'interface opening' stamp: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:39'!
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: 'jmv 1/15/2005 20:38'!
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: 'interface opening' stamp: 'jmv 5/28/2006 14:41'!
optionalButtonRow
	| row btn |
	row := AlignmentMorph newRow.
	row beSticky.
	row hResizing: #spaceFill.
	row
		wrapCentering: #center;
		cellPositioning: #leftCenter.
	row clipSubmorphs: true.
	row cellInset: 3.
	self optionalButtonPairs do: 
			[:pair | 
			btn := PluggableButtonMorph 
						on: self
						getState: nil
						action: pair second.
			btn
				hResizing: #spaceFill;
				vResizing: #spaceFill;
				onColor: Color transparent offColor: Color transparent;
				label: pair first.
			row addMorphBack: btn].
	^row! !

!TestRunner methodsFor: 'menus' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 1/15/2005 20:25'!
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: 'jmv 1/15/2005 20:25'!
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: 'class initialization' stamp: 'jmv 5/22/2006 20:20'!
initialize
	"TestRunner initialize"

	(TheWorldMenu respondsTo: #registerOpenCommand:) 
		ifTrue: 
			[TheWorldMenu unregisterOpenCommand: 'Test Runner'.
			TheWorldMenu registerOpenCommand: { 
						'SUnit Test Runner'.
						{ 
							self.
							#open}}]! !

!TestRunner class methodsFor: 'class initialization' stamp: 'jmv 1/15/2005 20:22'!
unload
	(TheWorldMenu respondsTo: #registerOpenCommand:) 
		ifTrue: [TheWorldMenu unregisterOpenCommand: 'SUnit Test Runner']! !


!TextComposer methodsFor: 'as yet unclassified' stamp: 'jmv 1/15/2005 20:46'!
addNullLineWithIndex: index andRectangle: r 
	lines addLast: ((TextLine 
				start: index
				stop: index - 1
				internalSpaces: 0
				paddingWidth: 0)
				rectangle: r;
				lineHeight: defaultLineHeight baseline: theTextStyle baseline)! !


!TextEditor methodsFor: 'editing keys' stamp: 'jmv 11/4/2008 11:51'!
changeEmphasis: characterStream 
	"Change the emphasis of the current selection or prepare to accept characters with the change in emphasis. Emphasis change amounts to a font change.  Keeps typeahead."

	"control 0..9 -> 0..9"

	| keyCode attribute oldAttributes index thisSel colors extras |
	keyCode := ('0123456789-=' indexOf: sensor keyboard ifAbsent: [1]) - 1.
	oldAttributes := paragraph text attributesAt: self pointIndex
				forStyle: paragraph textStyle.
	thisSel := self selection.

	"Decipher keyCodes for Command 0-9..."
	(keyCode between: 1 and: 5) 
		ifTrue: [attribute := TextFontChange fontNumber: keyCode].
	keyCode = 6 
		ifTrue: 
			[colors := #(#black #magenta #red #yellow #green #blue #cyan #white).
			extras := (self morph isKindOf: TextMorphForEditView)
							ifFalse: 
								["not a system window"

								#()]
							ifTrue: 
								[#('Link to comment of class' 'Link to definition of class' 'Link to hierarchy of class' 'Link to method')].
			index := (PopUpMenu 
						labelArray: colors , #('choose color...' 'Do it' 'Print it') , extras 
								, #('be a web URL link' 'Edit hidden info' 'Copy hidden info')
						lines: (Array with: colors size + 1)) startUp.
			index = 0 ifTrue: [^true].
			index <= colors size 
				ifTrue: [attribute := TextColor color: (Color perform: (colors at: index))]
				ifFalse: 
					[index := index - colors size - 1.	"Re-number!!!!!!"
					index = 0 ifTrue: [attribute := self chooseColor].
					index = 1 
						ifTrue: 
							[attribute := TextDoIt new.
							thisSel := attribute analyze: self selection asString].
					index = 2 
						ifTrue: 
							[attribute := TextPrintIt new.
							thisSel := attribute analyze: self selection asString].
					extras size = 0 & (index > 2) ifTrue: [index := index + 5].	"skip those"
					index = 3 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Comment'].
					index = 4 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Definition'].
					index = 5 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString with: 'Hierarchy'].
					index = 6 
						ifTrue: 
							[attribute := TextLink new.
							thisSel := attribute analyze: self selection asString].
					index = 7 
						ifTrue: 
							[attribute := TextURL new.
							thisSel := attribute analyze: self selection asString].
					index = 8 
						ifTrue: 
							["Edit hidden info"

							thisSel := self hiddenInfo.	"includes selection"
							attribute := TextEmphasis normal].
					index = 9 
						ifTrue: 
							["Copy hidden info"

							self copyHiddenInfo.
							^true].	"no other action"
					thisSel ifNil: [^true]	"Could not figure out what to link to"]].
	(keyCode between: 7 and: 11) 
		ifTrue: 
			[sensor leftShiftDown 
				ifTrue: 
					[keyCode = 10 ifTrue: [attribute := TextKern kern: -1].
					keyCode = 11 ifTrue: [attribute := TextKern kern: 1]]
				ifFalse: 
					[attribute := TextEmphasis 
								perform: (#(#bold #italic #narrow #underlined #struckOut) at: keyCode - 6).
					oldAttributes 
						do: [:att | (att dominates: attribute) ifTrue: [attribute turnOff]]]].
	keyCode = 0 ifTrue: [attribute := TextEmphasis normal].
	beginTypeInBlock ~~ nil 
		ifTrue: 
			["only change emphasisHere while typing"

			self insertTypeAhead: characterStream.
			emphasisHere := Text addAttribute: attribute toArray: oldAttributes.
			^true].
	self replaceSelectionWith: (thisSel asText addAttribute: attribute).
	^true! !

!TextEditor methodsFor: 'editing keys' stamp: 'jmv 11/4/2008 11:51'!
chooseColor
	"Make a new Text Color Attribute, let the user pick a color, and return the attribute"

	| attribute |
	(ColorPickerMorph new)
		choseModalityFromPreference;
		sourceHand: morph activeHand;
		target: (attribute := TextColor color: Color black);
		selector: #color:;
		originalColor: Color black;
		putUpFor: morph near: morph fullBoundsInWorld.	"default"
	^attribute! !

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

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

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


!TextMorph methodsFor: 'anchors' stamp: 'jmv 1/15/2005 20:46'!
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: 'jmv 1/15/2005 20:46'!
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: 
							["Return to simple rectangular bounds"

							nil]
						ifFalse: [container fillsOwner: container fillsOwner not]])! !

!TextMorph methodsFor: 'containment' stamp: 'jmv 1/15/2005 20:46'!
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: 
							["Return to simple rectangular bounds"

							nil]
						ifFalse: [container avoidsOcclusions: container avoidsOcclusions not]])! !

!TextMorph methodsFor: 'editing' stamp: 'jmv 1/15/2005 20:47'!
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: 'menu' stamp: 'jmv 11/6/2008 17:47'!
addCustomMenuItems: aCustomMenu hand: aHandMorph 
	"Add text-related menu items to the menu"

	| outer |
	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	aCustomMenu 
		addUpdating: #autoFitString
		target: self
		action: #autoFitOnOff.
	aCustomMenu 
		addUpdating: #wrapString
		target: self
		action: #wrapOnOff.
	aCustomMenu add: 'text margins...' translated action: #changeMargins:.
	(Preferences noviceMode or: [Preferences simpleMenus]) 
		ifFalse: 
			[aCustomMenu add: 'code pane menu...' translated
				action: #yellowButtonActivity.
			aCustomMenu add: 'code pane shift menu....' translated
				action: #shiftedYellowButtonActivity].
	outer := self owner.
	((outer isKindOf: PolygonMorph) and: [outer isOpen]) 
		ifTrue: 
			[container isNil 
				ifFalse: 
					[aCustomMenu add: 'reverse direction' translated
						action: #reverseCurveDirection.
					aCustomMenu add: 'set baseline' translated action: #setCurveBaseline:]]
		ifFalse: 
			[(container isNil or: [container fillsOwner not]) 
				ifTrue: 
					[aCustomMenu add: 'fill owner''s shape' translated action: #fillingOnOff]
				ifFalse: 
					[aCustomMenu add: 'rectangular bounds' translated action: #fillingOnOff].
			(container isNil or: [container avoidsOcclusions not]) 
				ifTrue: 
					[aCustomMenu add: 'avoid occlusions' translated action: #occlusionsOnOff]
				ifFalse: 
					[aCustomMenu add: 'ignore occlusions' translated action: #occlusionsOnOff]]! !

!TextMorph methodsFor: 'menu' stamp: 'jmv 3/27/2009 09:57'!
changeMargins: evt 
	| handle origin aHand newMargin |
	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).
					newMargin := (newPoint - origin max: 0 @ 0) // 5.
					self margins: newMargin]
				lastPointDo: 
					[:newPoint | 
					handle deleteBalloon.
					self halo ifNotNilDo: [:halo | halo addHandles]].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle 
		showBalloon: 'Move cursor down and to the right
to increase margin inset.
Click when done.'
		hand: evt hand.
	handle startStepping! !

!TextMorph methodsFor: 'menu' stamp: 'jmv 1/15/2005 20:23'!
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: 'jmv 1/15/2005 20:46'!
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! !


!TextStyle class methodsFor: 'mime file in/out' stamp: 'jmv 1/15/2005 20:24'!
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: 'jmv 4/23/2007 23:32'!
fontMenuForStyle: styleName target: target selector: selector highlight: currentSize 
	"Offer a font menu for the given style. If one is selected, pass that font to target with a call to selector. The fonts will be displayed in that font."

	| aMenu |
	aMenu := MenuMorph entitled: styleName.
	(self pointSizesFor: styleName) do: 
			[:aWidth | 
			| font |
			font := (self named: styleName) fontOfPointSize: aWidth.
			aMenu 
				add: aWidth asString , ' Point'
				target: target
				selector: selector
				argument: font.
			aMenu lastItem font: font.
			aWidth = currentSize ifTrue: [aMenu lastItem color: Color blue darker]].
	^aMenu! !

!TextStyle class methodsFor: 'user interface' stamp: 'jmv 2/12/2008 19:23'!
modalStyleSelectorWithTitle: title 
	"Presents a modal font-style choice menu, answers a TextStyle or nil."

	"TextStyle modalStyleSelectorWithTitle: 'testing'"

	| menu |
	menu := MenuMorph entitled: title.
	self actualTextStyles keysAndValuesDo: 
			[:styleName :style | 
			menu 
				add: styleName
				target: menu
				selector: #modalSelection:
				argument: style.
			menu lastItem font: (style fontOfSize: 18)].
	^menu invokeModal! !

!TextStyle class methodsFor: 'user interface' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 3/27/2009 09:57'!
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: 'commands' stamp: 'jmv 2/12/2008 19:10'!
setDisplayDepth
	"Let the user choose a new depth for the display. "

	| result oldDepth allDepths allLabels menu hasBoth |
	oldDepth := Display nativeDepth.
	allDepths := #(1 -1 2 -2 4 -4 8 -8 16 -16 32 -32) 
				select: [:d | Display supportsDisplayDepth: d].
	hasBoth := (allDepths anySatisfy: [:d | d > 0]) 
				and: [allDepths anySatisfy: [:d | d < 0]].
	allLabels := allDepths collect: 
					[:d | 
					String streamContents: 
							[:s | 
							s nextPutAll: (d = oldDepth ifTrue: ['<on>'] ifFalse: ['<off>']).
							s print: d abs.
							hasBoth 
								ifTrue: 
									[s 
										nextPutAll: (d > 0 ifTrue: ['  (big endian)'] ifFalse: ['  (little endian)'])]]].
	menu := SelectionMenu labels: allLabels selections: allDepths.
	result := menu startUpWithCaption: 'Choose a display depth' translated.
	result ifNotNil: [Display newDepth: result].
	oldDepth := oldDepth abs.
	(Display depth < 4 ~= (oldDepth < 4)) 
		ifTrue: 
			["Repaint windows since they look better all white in depth < 4"

			(SystemWindow windowsIn: myWorld satisfying: [:w | true]) do: 
					[:w | 
					oldDepth < 4 
						ifTrue: [w restoreDefaultPaneColor]
						ifFalse: [w updatePaneColors]]]! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 1/15/2005 20:35'!
alphabeticalMorphMenu
	| list splitLists menu firstChar lastChar subMenu |
	list := Morph withAllSubclasses select: [:m | m includeInNewMorphMenu].
	list := list asArray sortBy: [:c1 :c2 | c1 name < c2 name].
	splitLists := self splitNewMorphList: list depth: 3.
	menu := MenuMorph new defaultTarget: self.
	1 to: splitLists size
		do: 
			[:i | 
			firstChar := i = 1 
						ifTrue: [$A]
						ifFalse: [((splitLists at: i - 1) last name first asInteger + 1) asCharacter].
			lastChar := i = splitLists size 
						ifTrue: [$Z]
						ifFalse: [(splitLists at: i) last name first].
			subMenu := MenuMorph new.
			(splitLists at: i) do: 
					[:cl | 
					subMenu 
						add: cl name
						target: self
						selector: #newMorphOfClass:event:
						argument: cl].
			menu add: firstChar asString , ' - ' , lastChar asString subMenu: subMenu].
	^menu! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 2/15/2008 00:52'!
buildWorldMenu
	"Build the menu that is put up when the screen-desktop is clicked on"

	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu commandKeyHandler: self.
	self colorForDebugging: menu.
	menu addStayUpItem.
	self fillIn: menu
		from: { 
				{ 
					'restore display (r)'.
					{ 
						World.
						#restoreMorphicDisplay}.
					'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.'}.
				nil}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'open...'.
							{ 
								self.
								#openWindow}}.
						{ 
							'windows...'.
							{ 
								self.
								#windowsDo}}.
						{ 
							'changes...'.
							{ 
								self.
								#changesDo}}}].
	self fillIn: menu
		from: { 
				{ 
					'help...'.
					{ 
						self.
						#helpDo}.
					'puts up a menu of useful items for updating the system, determining what version you are running, and much else'}.
				{ 
					'appearance...'.
					{ 
						self.
						#appearanceDo}.
					'put up a menu offering many controls over appearance.'}}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'do...'.
							{ 
								Utilities.
								#offerCommonRequests}.
							'put up an editible list of convenient expressions, and evaluate the one selected.'}}].
	self fillIn: menu
		from: { 
				nil.
				{ 
					'new morph...'.
					{ 
						self.
						#newMorph}.
					'Offers a variety of ways to create new objects'}.
				}.
	Preferences simpleMenus 
		ifFalse: 
			[self fillIn: menu
				from: { 
						{ 
							'debug...'.
							{ 
								self.
								#debugDo}.
							'a menu of debugging items'}}].
	self fillIn: menu
		from: { 
				nil.
				{ 
					'save'.
					{ 
						Smalltalk .
						#saveSession}.
					'save the current version of the image on disk'}.
				{ 
					'save as...'.
					{ 
						Smalltalk .
						#saveAs}.
					'save the current version of the image on disk under a new name.'}.
				{ 
					'save as new version'.
					{ 
						Smalltalk .
						#saveAsNewVersion}.
					'give the current image a new version-stamped name and save it under that name on disk.'}.
				{ 
					'save and quit'.
					{ 
						self.
						#saveAndQuit}.
					'save the current image on disk, and quit out of Squeak.'}.
				{ 
					'quit'.
					{ 
						self.
						#quitSession}.
					'quit out of Squeak.'}}.
	^menu! !

!TheWorldMenu methodsFor: 'construction' stamp: 'jmv 5/28/2006 10:45'!
newMorph
	"The user requested 'new morph' from the world menu.  Put up a menu that allows many ways of obtaining new morphs.  If the preference #classicNewMorphMenu is true, the full form of yore is used; otherwise, a much shortened form is used."

	| menu subMenu catDict shortCat class |
	menu := self menu: 'Add a new morph'.
	menu
		add: 'from paste buffer' translated
			target: myHand
			action: #pasteMorph;
		add: 'from alphabetical list' translated
			subMenu: self alphabeticalMorphMenu.
	menu addLine.
	Preferences classicNewMorphMenu 
		ifTrue: 
			[menu addLine.
			catDict := Dictionary new.
			SystemOrganization categories do: 
					[:cat | 
					((cat beginsWith: 'Morphic-') 
						and: [(#('Morphic-Menus' 'Morphic-Support') includes: cat) not]) 
							ifTrue: 
								[shortCat := (cat copyFrom: 'Morphic-' size + 1 to: cat size) translated.
								(SystemOrganization listAtCategoryNamed: cat) do: 
										[:cName | 
										class := Smalltalk at: cName.
										((class inheritsFrom: Morph) and: [class includeInNewMorphMenu]) 
											ifTrue: 
												[(catDict includesKey: shortCat) 
													ifTrue: [(catDict at: shortCat) addLast: class]
													ifFalse: [catDict at: shortCat put: (OrderedCollection with: class)]]]]].
			catDict keys asSortedCollection do: 
					[:categ | 
					subMenu := MenuMorph new.
					((catDict at: categ) asSortedCollection: [:c1 :c2 | c1 name < c2 name]) 
						do: 
							[:cl | 
							subMenu 
								add: cl name
								target: self
								selector: #newMorphOfClass:event:
								argument: cl].
					menu add: categ subMenu: subMenu]].
	self doPopUp: menu! !

!TheWorldMenu methodsFor: 'mechanics' stamp: 'jmv 1/15/2005 20:35'!
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: 'jmv 3/27/2009 09:57'!
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.'}}! !


!TranscriptStream methodsFor: 'initialization' stamp: 'jmv 2/12/2008 19:45'!
open
	| openCount |
	openCount _ 0.
	self dependents
		do: [:d | (d isKindOf: PluggableTextMorph)
				ifTrue: [openCount _ openCount + 1]].
	openCount = 0
		ifTrue: [self openLabel: 'Transcript']
		ifFalse: [self openLabel: 'Transcript #' , (openCount + 1) printString]! !

!TranscriptStream methodsFor: 'initialization' stamp: 'jmv 1/15/2005 20:34'!
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! !


!Utilities class methodsFor: 'common requests' stamp: 'jmv 2/12/2008 19:24'!
closeAllDebuggers
	"Utilities closeAllDebuggers"

	(SystemWindow allSubInstances select: [:w | w model isKindOf: Debugger]) 
				do: [:w | w delete]! !

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

	"Utilities offerCommonRequests"

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

!Utilities class methodsFor: 'miscellaneous' stamp: 'jmv 1/15/2005 20:25'!
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: 'user interface' stamp: 'jmv 2/12/2008 19:25'!
informUser: aString during: aBlock 
	"Display a message above (or below if insufficient room) the cursor during execution of the given block."

	"Utilities informUser: 'Just a sec!!' during: [(Delay forSeconds: 1) wait]"

	(MVCMenuMorph from: (SelectionMenu labels: '') title: aString) 
				displayAt: Sensor cursorPoint
				during: [aBlock value]! !

!Utilities class methodsFor: 'user interface' stamp: 'jmv 2/12/2008 19:25'!
informUserDuring: aBlock 
	"Display a message above (or below if insufficient room) the cursor during execution of the given block."

	"Utilities informUserDuring:[:bar|
		#(one two three) do:[:info|
			bar value: info.
			(Delay forSeconds: 1) wait]]"

	(MVCMenuMorph from: (SelectionMenu labels: '') title: '						') 
				informUserAt: Sensor cursorPoint
				during: aBlock! !


!WaveletCodec methodsFor: 'subclass responsibilities' stamp: 'jmv 1/15/2005 20:24'!
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! !


!Workspace methodsFor: 'as yet unclassified' stamp: 'jmv 2/12/2008 19:52'!
saveContentsInFile
	"A bit of a hack to pass along this message to the controller or morph.  (Possibly this Workspace menu item could be deleted, since it's now in the text menu.)"

	| textMorph |
	textMorph := self dependents 
				detect: [:dep | dep isKindOf: PluggableTextMorph]
				ifNone: [nil].
	textMorph notNil ifTrue: [^textMorph saveContentsInFile]! !


!WorldState methodsFor: 'update cycle' stamp: 'jmv 1/15/2005 20:25'!
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! !


!WorldTest methodsFor: 'as yet unclassified' stamp: 'ar 3/24/2009 22:21'!
testDoOneCycleWorksWithDeferredQueue
        "Ensure that nested doOneCycles don't break deferred UI messages"
        | finished |
        [
                WorldState addDeferredUIMessage: [ World doOneCycleNow ].
                WorldState addDeferredUIMessage: [ "whatever" ].
                World doOneCycleNow.
                finished _ true.
        ] valueWithin: 1 second onTimeout: [finished _ false ].
        self assert: finished! !

TestRunner initialize!
