[squeak-dev] The Trunk: Morphic-Kernel-chc.1.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Dec 20 17:36:16 UTC 2011


Chris Cunnington uploaded a new version of Morphic-Kernel to project The Trunk:
http://source.squeak.org/trunk/Morphic-Kernel-chc.1.mcz

==================== Summary ====================

Name: Morphic-Kernel-chc.1
Author: chc
Time: 5 September 2010, 9:10:53.111 pm
UUID: da6bf99e-0d1b-4bb9-a9ef-8d7ddfece535
Ancestors: 

Making a change to the Help>>Extending the system menu selection. The aim is to freeze the versions of the refactoring browser for the time being. Lukas is making changes in the last few weeks that are drifting away from Squeak. I propose we freeze a version that works. Then we can review the versions in the future. 

So from: 

(Installer ss project: 'rb')
	install: 'AST';
	install: 'Refactoring-Core';
	install: 'Refactoring-Spelling';
	project: 'Regex';
	install: 'VB-Regex'.

To: 

(Installer ss project: 'rb')
	install: 'AST-Core-lr.80.mcz';
	install: 'AST-Semantic-lr.11.mcz';
	install: 'Refactoring-Core-lr.149.mcz';
	install: 'Refactoring-Spelling';
	project: 'Regex';
	install: 'VB-Regex'.

==================== Snapshot ====================

SystemOrganization addCategory: #'Morphic-Kernel'!

Object subclass: #Morph
	instanceVariableNames: 'bounds owner submorphs fullBounds color extension'
	classVariableNames: 'EmptyArray'
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!Morph commentStamp: 'efc 2/26/2003 20:01' prior: 0!
A Morph (from the Greek "shape" or "form") is an interactive graphical object. General information on the Morphic system can be found at http://minnow.cc.gatech.edu/squeak/30. 

Morphs exist in a tree, rooted at a World (generally a PasteUpMorph). The morphs owned by a morph are its submorphs. Morphs are drawn recursively; if a Morph has no owner it never gets drawn. To hide a Morph and its submorphs, set its #visible property to false using the #visible: method. 

The World (screen) coordinate system is used for most coordinates, but can be changed if there is a TransformMorph somewhere in the owner chain. 

My instance variables have accessor methods (e.g., #bounds, #bounds:). Most users should use the accessor methods instead of using the instance variables directly.

Structure:
instance var 	Type 			Description 
bounds 			Rectangle 		A Rectangle indicating my position and a size that will enclose 									me. 
owner 			Morph		 	My parent Morph, or nil for the top-level Morph, which is a
 				or nil			world, typically a PasteUpMorph.
submorphs 		Array 			My child Morphs. 
fullBounds 		Rectangle 		A Rectangle minimally enclosing me and my submorphs. 
color 			Color 			My primary color. Subclasses can use this in different ways. 
extension 		MorphExtension Allows extra properties to be stored without adding a
				or nil  				storage burden to all morphs. 

By default, Morphs do not position their submorphs. Morphs may position their submorphs directly or use a LayoutPolicy to automatically control their submorph positioning.

Although Morph has some support for BorderStyle, most users should use BorderedMorph if they want borders.!

Morph subclass: #BorderedMorph
	instanceVariableNames: 'borderWidth borderColor'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!BorderedMorph commentStamp: 'kfr 10/27/2003 11:17' prior: 0!
BorderedMorph introduce borders to morph. Borders have the instanceVariables borderWidth and borderColor.
 
BorderedMorph new borderColor: Color red; borderWidth: 10; openInWorld.

BorderedMorph also have a varaity of border styles: simple, inset, raised, complexAltFramed, complexAltInset, complexAltRaised, complexFramed, complexInset, complexRaised.
These styles are set using the classes BorderStyle, SimpleBorder, RaisedBorder, InsetBorder and ComplexBorder.

BorderedMorph new borderStyle: (SimpleBorder width: 1 color: Color white); openInWorld.
BorderedMorph new borderStyle: (BorderStyle inset width: 2); openInWorld.


!

----- Method: BorderedMorph>>acquireBorderWidth: (in category 'geometry') -----
acquireBorderWidth: aBorderWidth
	"Gracefully acquire the new border width, keeping the interior area intact and not seeming to shift"

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

----- Method: BorderedMorph>>addBorderStyleMenuItems:hand: (in category 'menu') -----
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 translated target: self selector: #setBorderStyle: argument: sym]].
	aMenu add: 'border style' translated subMenu: subMenu
!

----- Method: BorderedMorph>>addCornerGrips (in category 'lookenhancements') -----
addCornerGrips
	self
		addMorphBack: (TopLeftGripMorph new target: self; position: self position).
	self
		addMorphBack: (TopRightGripMorph new target: self; position: self position).
	self
		addMorphBack: (BottomLeftGripMorph new target: self;position: self position).
	self
		addMorphBack: (BottomRightGripMorph new target: self;position: self position)!

----- Method: BorderedMorph>>addEdgeGrips (in category 'lookenhancements') -----
addEdgeGrips
	"Add resizers along the four edges of the receiver"

	self
		addMorphBack: (TopGripMorph new target: self;position: self position).
	self
		addMorphBack: (BottomGripMorph new target: self;position: self position).
	self
		addMorphBack: (RightGripMorph new target: self;position: self position).
	self
		addMorphBack: (LeftGripMorph new target: self;position: self position).!

----- Method: BorderedMorph>>addPaneHSplitterBetween:and: (in category 'lookenhancements') -----
addPaneHSplitterBetween: topMorph and: bottomMorphs

	| targetY minX maxX splitter |
	targetY := topMorph layoutFrame bottomFraction.

	minX := (bottomMorphs detectMin: [:each | each layoutFrame leftFraction]) layoutFrame leftFraction.
	maxX := (bottomMorphs detectMax: [:each | each layoutFrame rightFraction]) layoutFrame rightFraction.
	splitter := ProportionalSplitterMorph new beSplitsTopAndBottom; yourself.
	splitter layoutFrame: (LayoutFrame
		fractions: (minX @ targetY corner: maxX @ targetY)
		offsets: (((topMorph layoutFrame leftOffset ifNil: [0]) @ 0 corner: (topMorph layoutFrame rightOffset ifNil: [0]) @ 4) translateBy: 0 @ (topMorph layoutFrame bottomOffset ifNil: [0]))).

	self addMorphBack: (splitter position: self position).!

----- Method: BorderedMorph>>addPaneSplitters (in category 'lookenhancements') -----
addPaneSplitters
	| splitter remaining target targetX sameX minY maxY targetY sameY minX maxX |
	self removePaneSplitters.
	self removeCornerGrips.

	remaining := submorphs reject: [:each | each layoutFrame rightFraction = 1].
	[remaining notEmpty] whileTrue:
		[target := remaining first.
		targetX := target layoutFrame rightFraction.
		sameX := submorphs select: [:each | each layoutFrame rightFraction = targetX].
		minY := (sameX detectMin: [:each | each layoutFrame topFraction]) layoutFrame topFraction.
		maxY := (sameX detectMax: [:each | each layoutFrame bottomFraction]) layoutFrame bottomFraction.
		splitter := ProportionalSplitterMorph new.
		splitter layoutFrame: (LayoutFrame
			fractions: (targetX @ minY corner: targetX @ maxY)
			offsets: ((0 @ (target layoutFrame topOffset ifNil: [0]) corner: 4 @ (target layoutFrame bottomOffset ifNil: [0])) translateBy: (target layoutFrame rightOffset ifNil: [0]) @ 0)).
		self addMorphBack: (splitter position: self position).
		remaining := remaining copyWithoutAll: sameX].

	remaining := submorphs copy reject: [:each | each layoutFrame bottomFraction = 1].
	[remaining notEmpty]
		whileTrue: [target := remaining first.
			targetY := target layoutFrame bottomFraction.
			sameY := submorphs select: [:each | each layoutFrame bottomFraction = targetY].
			minX := (sameY detectMin: [:each | each layoutFrame leftFraction]) layoutFrame leftFraction.
			maxX := (sameY detectMax: [:each | each layoutFrame rightFraction]) layoutFrame rightFraction.
			splitter := ProportionalSplitterMorph new beSplitsTopAndBottom; yourself.
			splitter layoutFrame: (LayoutFrame
				fractions: (minX @ targetY corner: maxX @ targetY)
				offsets: (((target layoutFrame leftOffset ifNil: [0]) @ 0 corner: (target layoutFrame rightOffset ifNil: [0]) @ 4) translateBy: 0 @ (target layoutFrame bottomOffset ifNil: [0]))).
			self addMorphBack: (splitter position: self position).
			remaining := remaining copyWithoutAll: sameY].

	self linkSubmorphsToSplitters.
	self splitters do: [:each | each comeToFront].
!

----- Method: BorderedMorph>>addPaneVSplitterBetween:and: (in category 'lookenhancements') -----
addPaneVSplitterBetween: leftMorph and: rightMorphs 

	| targetX minY maxY splitter |
	targetX := leftMorph layoutFrame rightFraction.
	minY := (rightMorphs detectMin: [:each | each layoutFrame topFraction]) layoutFrame topFraction.
	maxY := (rightMorphs detectMax: [:each | each layoutFrame bottomFraction]) layoutFrame bottomFraction.
	
	splitter := ProportionalSplitterMorph new.
	splitter layoutFrame: (LayoutFrame
		fractions: (targetX @ minY corner: targetX @ maxY)
		offsets: ((0 @ (leftMorph layoutFrame topOffset ifNil: [0]) corner: (4@ (leftMorph layoutFrame bottomOffset ifNil: [0]))) translateBy: (leftMorph layoutFrame rightOffset ifNil: [0]) @ 0)).

	self addMorphBack: (splitter position: self position).!

----- Method: BorderedMorph>>areasRemainingToFill: (in category 'drawing') -----
areasRemainingToFill: aRectangle
	"Fixed here to test the fillStyle rather than color for translucency.
	Since can have a translucent fillStyle while the (calculated) color is not."
	
	self fillStyle isTranslucent
		ifTrue: [^ Array with: aRectangle].
	self wantsRoundedCorners
		ifTrue: [(self borderWidth > 0
					and: [self borderColor isColor
							and: [self borderColor isTranslucent]])
				ifTrue: [^ aRectangle
						areasOutside: (self innerBounds intersect: self boundsWithinCorners)]
				ifFalse: [^ aRectangle areasOutside: self boundsWithinCorners]]
		ifFalse: [(self borderWidth > 0
					and: [self borderColor isColor
							and: [self borderColor isTranslucent]])
				ifTrue: [^ aRectangle areasOutside: self innerBounds]
				ifFalse: [^ aRectangle areasOutside: self bounds]]
!

----- Method: BorderedMorph>>borderColor (in category 'accessing') -----
borderColor
	^ borderColor!

----- Method: BorderedMorph>>borderColor: (in category 'accessing') -----
borderColor: colorOrSymbolOrNil
	self doesBevels ifFalse:[
		colorOrSymbolOrNil isColor ifFalse:[^self]].
	borderColor = colorOrSymbolOrNil ifFalse: [
		borderColor := colorOrSymbolOrNil.
		self changed].
!

----- Method: BorderedMorph>>borderInitialize (in category 'initialization') -----
borderInitialize
	"initialize the receiver state related to border"
	borderColor:= self defaultBorderColor.
	borderWidth := self defaultBorderWidth!

----- Method: BorderedMorph>>borderInset (in category 'accessing') -----
borderInset
	self borderColor: #inset!

----- Method: BorderedMorph>>borderRaised (in category 'accessing') -----
borderRaised
	self borderColor: #raised!

----- Method: BorderedMorph>>borderStyle (in category 'accessing') -----
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!

----- Method: BorderedMorph>>borderStyle: (in category 'accessing') -----
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!

----- Method: BorderedMorph>>borderWidth (in category 'accessing') -----
borderWidth
	^ borderWidth!

----- Method: BorderedMorph>>borderWidth: (in category 'accessing') -----
borderWidth: anInteger
	borderColor ifNil: [borderColor := Color black].
	borderWidth := anInteger max: 0.
	self changed!

----- Method: BorderedMorph>>changeBorderColor: (in category 'menu') -----
changeBorderColor: evt
	| aHand |
	aHand := evt ifNotNil: [evt hand] ifNil: [self primaryHand].
	self changeColorTarget: self selector: #borderColor: originalColor: self borderColor hand: aHand!

----- Method: BorderedMorph>>changeBorderWidth: (in category 'menu') -----
changeBorderWidth: evt
	| handle origin aHand newWidth oldWidth |
	aHand := evt ifNil: [self primaryHand] ifNotNil: [evt hand].
	origin := aHand position.
	oldWidth := borderWidth.
	(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 ifNotNil: [:halo | halo addHandles].
			self rememberCommand:
				(Command new cmdWording: 'border change' translated;
					undoTarget: self selector: #borderWidth: argument: oldWidth;
					redoTarget: self selector: #borderWidth: argument: newWidth)].
	aHand attachMorph: handle.
	handle setProperty: #helpAtCenter toValue: true.
	handle showBalloon:
'Move cursor farther from
this point to increase border width.
Click when done.' translated hand: evt hand.
	handle startStepping!

----- Method: BorderedMorph>>closestPointTo: (in category 'geometry') -----
closestPointTo: aPoint
	"account for round corners. Still has a couple of glitches at upper left and right corners"
	| pt |
	pt := self bounds pointNearestTo: aPoint.
	self wantsRoundedCorners ifFalse: [ ^pt ].
	self bounds corners with: (self bounds insetBy: 6) corners do: [ :out :in |
		(pt - out) abs < (6 at 6)
			ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
	].
	^pt.!

----- Method: BorderedMorph>>defaultBorderColor (in category 'initialization') -----
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color black!

----- Method: BorderedMorph>>defaultBorderWidth (in category 'initialization') -----
defaultBorderWidth
	"answer the default border width for the receiver"
	^ 2!

----- Method: BorderedMorph>>doesBevels (in category 'accessing') -----
doesBevels
	"To return true means that this object can show bevelled borders, and
	therefore can accept, eg, #raised or #inset as valid borderColors.
	Must be overridden by subclasses that do not support bevelled borders."

	^ true!

----- Method: BorderedMorph>>hasTranslucentColor (in category 'accessing') -----
hasTranslucentColor
	"Answer true if this any of this morph is translucent but not transparent."

	(color isColor and: [color isTranslucentColor]) ifTrue: [^ true].
	(borderColor isColor and: [borderColor isTranslucentColor]) ifTrue: [^ true].
	^ false
!

----- Method: BorderedMorph>>initialize (in category 'initialization') -----
initialize
	"initialize the state of the receiver"
	super initialize.
""
	self borderInitialize!

----- Method: BorderedMorph>>intersectionWithLineSegmentFromCenterTo: (in category 'geometry') -----
intersectionWithLineSegmentFromCenterTo: aPoint
	"account for round corners. Still has a couple of glitches at upper left and right corners"
	| pt |
	pt := super intersectionWithLineSegmentFromCenterTo: aPoint.
	self wantsRoundedCorners ifFalse: [ ^pt ].
	self bounds corners with: (self bounds insetBy: 6) corners do: [ :out :in |
		(pt - out) abs < (6 at 6)
			ifTrue: [ ^(in + (Point r: 5.0 degrees: (pt - in) degrees)) asIntegerPoint ].
	].
	^pt.!

----- Method: BorderedMorph>>linkSubmorphsToSplitters (in category 'lookenhancements') -----
linkSubmorphsToSplitters

	self splitters do:
		[:each |
		each splitsTopAndBottom
			ifTrue:
				[self submorphsDo:
					[:eachMorph |
					(eachMorph ~= each and: [eachMorph layoutFrame bottomFraction = each layoutFrame topFraction]) ifTrue: [each addLeftOrTop: eachMorph].
					(eachMorph ~= each and: [eachMorph layoutFrame topFraction = each layoutFrame bottomFraction]) ifTrue: [each addRightOrBottom: eachMorph]]]
			ifFalse:
				[self submorphsDo:
					[:eachMorph |
					(eachMorph ~= each and: [eachMorph layoutFrame rightFraction = each layoutFrame leftFraction]) ifTrue: [each addLeftOrTop: eachMorph].
					(eachMorph ~= each and: [eachMorph layoutFrame leftFraction = each layoutFrame rightFraction]) ifTrue: [each addRightOrBottom: eachMorph]]]]!

----- Method: BorderedMorph>>removeCornerGrips (in category 'lookenhancements') -----
removeCornerGrips

	| corners |
	corners := self submorphsSatisfying: [:each | each isKindOf: CornerGripMorph].
	corners do: [:each | each delete]!

----- Method: BorderedMorph>>removePaneSplitters (in category 'lookenhancements') -----
removePaneSplitters

	self splitters do: [:each | each delete]!

----- Method: BorderedMorph>>setBorderWidth:borderColor: (in category 'private') -----
setBorderWidth: w borderColor: bc
	self borderWidth: w.
	self borderColor: bc.!

----- Method: BorderedMorph>>setColor:borderWidth:borderColor: (in category 'private') -----
setColor: c borderWidth: w borderColor: bc
	self color: c.
	self borderWidth: w.
	self borderColor: bc.!

----- Method: BorderedMorph>>splitters (in category 'lookenhancements') -----
splitters

	^ self submorphsSatisfying: [:each | each isKindOf: ProportionalSplitterMorph]!

----- Method: BorderedMorph>>useRoundedCorners (in category 'accessing') -----
useRoundedCorners
	self cornerStyle: #rounded!

----- Method: BorderedMorph>>useSquareCorners (in category 'accessing') -----
useSquareCorners
	self cornerStyle: #square!

BorderedMorph subclass: #MorphicModel
	instanceVariableNames: 'model slotName open'
	classVariableNames: 'TimeOfError'
	poolDictionaries: ''
	category: 'Morphic-Kernel'!
MorphicModel class
	instanceVariableNames: 'prototype'!

!MorphicModel commentStamp: '<historical>' prior: 0!
MorphicModels are used to represent structures with state and behavior as well as graphical structure.  A morphicModel is usually the root of a morphic tree depicting its appearance.  The tree is constructed concretely by adding its consituent morphs to a world.

When a part is named in a world, it is given a new slot in the model.  When a part is sensitized, it is named, and a set of mouse-driven methods is also generated in the model.  These may be edited to induce particular behavior.  When a variable is added through the morphic world, it is given a slot in the model, along with a set of access methods.

In addition for public variables (and this is the default for now), methods are generated and called in any outer model in which this model gets embedded, thus propagating variable changes outward.!
MorphicModel class
	instanceVariableNames: 'prototype'!

----- Method: MorphicModel class>>acceptsLoggingOfCompilation (in category 'compiling') -----
acceptsLoggingOfCompilation
	"Dont log sources for my automatically-generated subclasses.  Can easily switch this back when it comes to deal with Versions, etc."

	^ self == MorphicModel or: [(name last isDigit) not]!

----- Method: MorphicModel class>>categoryForSubclasses (in category 'compilation') -----
categoryForSubclasses
	^ 'Morphic-Models'!

----- Method: MorphicModel class>>chooseNewName (in category 'compilation') -----
chooseNewName
	"Choose a new name for the receiver, persisting until an acceptable name is provided or until the existing name is resubmitted"

	| oldName newName |
	oldName := self name.
		[newName := (UIManager default request: 'Please give this Model a name'
					initialAnswer: oldName) asSymbol.
		newName = oldName ifTrue: [^ self].
		Smalltalk includesKey: newName]
		whileTrue:
		[self inform: 'Sorry, that name is already in use.'].
	self rename: newName.!

----- Method: MorphicModel class>>compileAccessorsFor: (in category 'compilation') -----
compileAccessorsFor: varName
	self compile: (
'&var
	"Return the value of &var"
	^ &var'
			copyReplaceAll: '&var' with: varName)
		classified: 'public access' notifying: nil.
	self compile: (
'&varPut: newValue
	"Assign newValue to &var.
	Add code below to update related graphics appropriately..."

	&var _ newValue.'
			copyReplaceAll: '&var' with: varName)
		classified: 'public access' notifying: nil.
	self compile: (
'&var: newValue
	"Assigns newValue to &var and updates owner"
	&var _ newValue.
	self propagate: &var as: ''&var:'''
			copyReplaceAll: '&var' with: varName)
		classified: 'private - propagation' notifying: nil.
!

----- Method: MorphicModel class>>compilePropagationForVarName:slotName: (in category 'compilation') -----
compilePropagationForVarName: varName slotName: slotName
	self compile: ((
'&slot&var: newValue
	"The value of &var in &slot has changed to newValue.
	This value can be read elsewhere in code with
		&slot &var
	and it can be stored into with
		&slot &varPut: someValue"

	"Add code for appropriate response here..."'
			copyReplaceAll: '&var' with: varName)
			copyReplaceAll: '&slot' with: slotName)
		classified: 'input events' notifying: nil.
!

----- Method: MorphicModel class>>hasPrototype (in category 'queries') -----
hasPrototype
	"Return true if there is a prototype for this morph."

	^ prototype ~~ nil
!

----- Method: MorphicModel class>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
	"Only include Models that are appropriate"
	^ false!

----- Method: MorphicModel class>>new (in category 'instance creation') -----
new
	"Return a copy of the prototype, if there is one.
	Otherwise create a new instance normally."

	self hasPrototype ifTrue: [^ prototype veryDeepCopy].
	^ super new
!

----- Method: MorphicModel class>>newBounds:model:slotName: (in category 'instance creation') -----
newBounds: bounds model: thang slotName: nameOfThisPart
	^ (super new model: thang slotName: nameOfThisPart)
		newBounds: bounds!

----- Method: MorphicModel class>>newSubclass (in category 'subclass creation') -----
newSubclass
	| i className |
	i := 1.
	[className := (self name , i printString) asSymbol.
	 Smalltalk includesKey: className]
		whileTrue: [i := i + 1].

	^ self subclass: className
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: 'Morphic-Models'!

----- Method: MorphicModel class>>officialClass (in category 'testing') -----
officialClass
	"We want to make a new instance of the receiver, which is a subclass of MorphicModel.  Answer who to make a new subclass of.  Also used to tell if a given class is a UniClass, existing only for its single instance."

	^ self name last isDigit ifTrue: [MorphicModel] ifFalse: [self]
		"MorphicModel7 can not have subclasses, but Slider and SystemWindow may"!

----- Method: MorphicModel class>>prototype (in category 'prototype access') -----
prototype
	"Return the prototype for this morph."

	^ prototype
!

----- Method: MorphicModel class>>prototype: (in category 'prototype access') -----
prototype: aMorph
	"Store a copy of the given morph as a prototype to be copied to make new instances."

	aMorph ifNil: [prototype := nil. ^ self].

	prototype := aMorph veryDeepCopy.
	(prototype isMorphicModel) ifTrue: 
		[prototype model: nil slotName: nil].
!

----- Method: MorphicModel class>>removeUninstantiatedModels (in category 'housekeeping') -----
removeUninstantiatedModels
	"With the user's permission, remove the classes of any models that have neither instances nor subclasses."
	"MorphicModel removeUninstantiatedModels"

	| candidatesForRemoval |
	Smalltalk garbageCollect.
	candidatesForRemoval :=
		MorphicModel subclasses select: [:c |
			(c instanceCount = 0) and: [c subclasses size = 0]].
	candidatesForRemoval do: [:c | | ok |
		ok := self confirm: 'Are you certain that you
want to delete the class ', c name, '?'.
		ok ifTrue: [c removeFromSystem]].
!

----- Method: MorphicModel class>>wantsChangeSetLogging (in category 'compiling') -----
wantsChangeSetLogging
	"Log changes for MorphicModel itself and for things like PlayWithMe2, but not for automatically-created subclasses like MorphicModel1, MorphicModel2, etc."

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

----- Method: MorphicModel>>addCustomMenuItems:hand: (in category 'menu') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph

	super addCustomMenuItems: aCustomMenu hand: aHandMorph.
	model ifNotNil: [model addModelMenuItemsTo: aCustomMenu forMorph: self hand: aHandMorph].
	self isOpen ifTrue: [aCustomMenu add: 'close editing' translated action: #closeToEdits]
			ifFalse: [aCustomMenu add: 'open editing' translated action: #openToEdits].
!

----- Method: MorphicModel>>addPartNameLike:withValue: (in category 'compilation') -----
addPartNameLike: className withValue: aMorph
	| otherNames i default partName stem |
	stem := className first asLowercase asString , className allButFirst.
	otherNames := self class allInstVarNames.
	i := 1.
	[otherNames includes: (default := stem, i printString)]
		whileTrue: [i := i + 1].
	partName := UIManager default
		request: 'Please give this part a name'
		initialAnswer: default.
	(otherNames includes: partName)
		ifTrue: [self inform: 'Sorry, that name is already used'. ^ nil].
	self class addInstVarName: partName.
	self instVarAt: self class instSize put: aMorph.  "Assumes added as last field"
	^ partName!

----- Method: MorphicModel>>allKnownNames (in category 'submorphs-accessing') -----
allKnownNames
	"Return a list of all known names based on the scope of the receiver.  If the receiver is a member of a uniclass, incorporate the original 1997 logic that queries the known names of the values of all the instance variables."

	| superNames |
	superNames := super allKnownNames.	"gather them from submorph tree"
	^self belongsToUniClass 
		ifTrue: 
			[superNames , (self instanceVariableValues 
						select: [:e | e notNil and: [e knownName notNil]]
						thenCollect: [:e | e knownName])]
		ifFalse: [superNames]!

----- Method: MorphicModel>>allowSubmorphExtraction (in category 'drag and drop') -----
allowSubmorphExtraction
	^ self isOpen
!

----- Method: MorphicModel>>choosePartName (in category 'naming') -----
choosePartName
	"When I am renamed, get a slot, make default methods, move any existing methods.  ** Does not clean up old inst var name or methods**  "

	| old |
	old := slotName.
	super choosePartName.
	slotName ifNil: [^self].	"user chose bad slot name"
	self model: self world model slotName: slotName.
	old isNil
		ifTrue: [self compilePropagationMethods]
		ifFalse: [self copySlotMethodsFrom: old]
	"old ones not erased!!"!

----- Method: MorphicModel>>closeToEdits (in category 'menu') -----
closeToEdits
	"Disable this morph's ability to add and remove morphs via drag-n-drop."

	open := false
!

----- Method: MorphicModel>>compileAccessForSlot: (in category 'compilation') -----
compileAccessForSlot: aSlotName
	"Write the method to get at this inst var.  "
	"Instead call the right thing to make this happen?"

	| s  |
	s := WriteStream on: (String new: 2000).
	s nextPutAll: aSlotName; cr; tab; nextPutAll: '^', aSlotName.
	self class
		compile: s contents
		classified: 'public access'
		notifying: nil.
!

----- Method: MorphicModel>>compilePropagationMethods (in category 'compilation') -----
compilePropagationMethods
	
	(self class organization listAtCategoryNamed: 'private - propagation' asSymbol)
		do: [:sel | | varName |
			varName := sel allButLast.
			model class compilePropagationForVarName: varName slotName: slotName]!

----- Method: MorphicModel>>defaultBorderColor (in category 'initialization') -----
defaultBorderColor
	"answer the default border color/fill style for the receiver"
	^ Color yellow!

----- Method: MorphicModel>>defaultBounds (in category 'initialization') -----
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 corner: 200 @ 100!

----- Method: MorphicModel>>defaultColor (in category 'initialization') -----
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color transparent!

----- Method: MorphicModel>>delete (in category 'submorphs-add/remove') -----
delete
	(model isMorphicModel) ifFalse: [^super delete].
	slotName ifNotNil: 
			[(UIManager default confirm: 'Shall I remove the slot ' , slotName 
						, '
along with all associated methods?') 
				ifTrue: 
					[(model class selectors select: [:s | s beginsWith: slotName]) 
						do: [:s | model class removeSelector: s].
					(model class instVarNames includes: slotName) 
						ifTrue: [model class removeInstVarName: slotName]]
				ifFalse: 
					[(UIManager default 
						confirm: '...but should I at least dismiss this morph?
[choose no to leave everything unchanged]') 
							ifFalse: [^self]]].
	super delete!

----- Method: MorphicModel>>duplicate:from: (in category 'initialization') -----
duplicate: newGuy from: oldGuy
	"oldGuy has just been duplicated and will stay in this world.  Make sure all the MorphicModel requirements are carried out for the copy.  Ask user to rename it.  "

	newGuy installModelIn: oldGuy world.
	newGuy copySlotMethodsFrom: oldGuy slotName.!

----- Method: MorphicModel>>initString (in category 'printing') -----
initString

	^ String streamContents:
		[:s | s nextPutAll: self class name;
			nextPutAll: ' newBounds: (';
			print: bounds;
			nextPutAll: ') model: self slotName: ';
			print: slotName]!

----- Method: MorphicModel>>initialize (in category 'initialization') -----
initialize
	"initialize the state of the receiver"
	super initialize.
""
	open := false!

----- Method: MorphicModel>>installModelIn: (in category 'debug and other') -----
installModelIn: aWorld

	self wantsSlot ifFalse: [^ self].  "No real need to install"
	slotName := aWorld model addPartNameLike: self class name withValue: self.
	slotName ifNil: [^ self].  "user chose bad slot name"
	self model: aWorld model slotName: slotName.
	self compilePropagationMethods.
	aWorld model compileAccessForSlot: slotName.
!

----- Method: MorphicModel>>isMorphicModel (in category 'classification') -----
isMorphicModel
	^true!

----- Method: MorphicModel>>isOpen (in category 'drag and drop') -----
isOpen
	"Support drag/drop and other edits."
	^ open!

----- Method: MorphicModel>>model (in category 'access') -----
model 
	^ model!

----- Method: MorphicModel>>model: (in category 'initialization') -----
model: anObject
	"Set my model and make me me a dependent of the given object."

	model ifNotNil: [model removeDependent: self].
	anObject ifNotNil: [anObject addDependent: self].
	model := anObject.
!

----- Method: MorphicModel>>model:slotName: (in category 'initialization') -----
model: thang slotName: nameOfThisPart
	model := thang.
	slotName := nameOfThisPart.
	open := false.!

----- Method: MorphicModel>>modelOrNil (in category 'accessing') -----
modelOrNil
	^ model!

----- Method: MorphicModel>>nameFor: (in category 'compilation') -----
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 := MorphicModel allInstVarNames size + 1.
	start to: allNames size do: [:i |
		(self instVarAt: i) == aMorph ifTrue: [^ allNames at: i]].
	^ nil
!

----- Method: MorphicModel>>newBounds: (in category 'geometry') -----
newBounds: newBounds
	self bounds: newBounds!

----- Method: MorphicModel>>openToEdits (in category 'menu') -----
openToEdits
	"Enable this morph's ability to add and remove morphs via drag-n-drop."

	open := true
!

----- Method: MorphicModel>>propagate:as: (in category 'compilation') -----
propagate: value as: partStoreSelector
	model ifNil: [^ self].
"
	Later we can cache this for more speed as follows...
	(partName == cachedPartName and: [slotName == cachedSlotName])
		ifFalse: [cachedPartName := partName.
				cachedSlotName := slotName.
				cachedStoreSelector := (slotName , partStoreSelector) asSymbol].
	model perform: cachedStoreSelector with: value].
"
	model perform: (self slotSelectorFor: partStoreSelector) with: value!

----- Method: MorphicModel>>recomputeBounds (in category 'geometry') -----
recomputeBounds

	| bnds |
	bnds := submorphs first bounds.
	bounds := bnds origin corner: bnds corner. "copy it!!"
	fullBounds := nil.
	bounds := self fullBounds.
!

----- Method: MorphicModel>>releaseCachedState (in category 'caching') -----
releaseCachedState
	"Release cached state of the receiver"

	(model ~~ self and: [model respondsTo: #releaseCachedState]) ifTrue:
		[model releaseCachedState].
	super releaseCachedState!

----- Method: MorphicModel>>removeAll (in category 'compilation') -----
removeAll
	"Clear out all script methods and subpart instance variables in me.  Start over."
	"self removeAll"
	"MorphicModel2 removeAll"

self class == MorphicModel ifTrue: [^ self].	"Must be a subclass!!"
self class removeCategory: 'scripts'.
self class instVarNames do: [:nn | self class removeInstVarName: nn].!

----- Method: MorphicModel>>slotName (in category 'access') -----
slotName
	^ slotName!

----- Method: MorphicModel>>slotSelectorFor: (in category 'compilation') -----
slotSelectorFor: selectorBody
	| selector |
	model ifNil: [^ nil].
	"Make up selector from slotname if any"
	selector := (slotName ifNil: [selectorBody]
					ifNotNil: [slotName , selectorBody]) asSymbol.
	(model canUnderstand: selector) ifFalse:
		[self halt: 'Compiling a null response for ' , model class name , '>>' , selector].
	^ selector!

----- Method: MorphicModel>>use:orMakeModelSelectorFor:in: (in category 'compilation') -----
use: cachedSelector orMakeModelSelectorFor: selectorBody in: selectorBlock
	| selector |
	model ifNil: [^ nil].
	cachedSelector ifNil:
			["Make up selector from slotname if any"
			selector := (slotName ifNil: [selectorBody]
								ifNotNil: [slotName , selectorBody]) asSymbol.
			(model class canUnderstand: selector) ifFalse:
				[(self confirm: 'Shall I compile a null response for'
							, Character cr asString
							, model class name , '>>' , selector)
						ifFalse: [self halt].
				model class compile: (String streamContents:
								[:s | selector keywords doWithIndex:
										[:k :i | s nextPutAll: k , ' arg' , i printString].
								s cr; nextPutAll: '"Automatically generated null response."'.
								s cr; nextPutAll: '"Add code below for appropriate behavior..."'.])
							classified: 'input events'
							notifying: nil]]
		ifNotNil:
			[selector := cachedSelector].
	^ selectorBlock value: selector!

----- Method: MorphicModel>>wantsSlot (in category 'access') -----
wantsSlot
	"Override this default for models that want to be installed in theri model"
	^ false!

Morph subclass: #HandMorph
	instanceVariableNames: 'mouseFocus keyboardFocus eventListeners mouseListeners keyboardListeners mouseClickState mouseOverHandler lastMouseEvent targetOffset damageRecorder cacheCanvas cachedCanvasHasHoles temporaryCursor temporaryCursorOffset hardwareCursor hasChanged savedPatch userInitials lastEventBuffer genieGestureProcessor keyboardInterpreter'
	classVariableNames: 'CompositionWindowManager DoubleClickTime EventStats NewEventRules NormalCursor PasteBuffer ShowEvents'
	poolDictionaries: 'EventSensorConstants'
	category: 'Morphic-Kernel'!

!HandMorph commentStamp: '<historical>' prior: 0!
The cursor may be thought of as the HandMorph.  The hand's submorphs hold anything being carried by dragging.  

There is some minimal support for multiple hands in the same world.!

----- Method: HandMorph class>>attach: (in category 'utilities') -----
attach: aMorph
	"Attach aMorph the current world's primary hand."

	self currentWorld primaryHand attachMorph: aMorph!

----- Method: HandMorph class>>clearCompositionWindowManager (in category 'initialization') -----
clearCompositionWindowManager

	CompositionWindowManager := nil.
!

----- Method: HandMorph class>>clearInterpreters (in category 'initialization') -----
clearInterpreters

	self allInstances do: [:each | each clearKeyboardInterpreter].
!

----- Method: HandMorph class>>compositionWindowManager (in category 'accessing') -----
compositionWindowManager
	CompositionWindowManager ifNotNil: [^CompositionWindowManager].
	Smalltalk platformName = 'Win32' 
		ifTrue: [^CompositionWindowManager := ImmWin32 new].
	(Smalltalk platformName = 'unix' 
		and: [(Smalltalk windowSystemName) = 'X11']) 
			ifTrue: [^CompositionWindowManager := ImmX11 new].
	^CompositionWindowManager := ImmAbstractPlatform new!

----- Method: HandMorph class>>doubleClickTime (in category 'accessing') -----
doubleClickTime

	^ DoubleClickTime
!

----- Method: HandMorph class>>doubleClickTime: (in category 'accessing') -----
doubleClickTime: milliseconds

	DoubleClickTime := milliseconds.
!

----- Method: HandMorph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
	"Not to be instantiated from the menu"
	^ false!

----- Method: HandMorph class>>initialize (in category 'class initialization') -----
initialize
	"HandMorph initialize"

	PasteBuffer := nil.
	DoubleClickTime := 350.
	NormalCursor := CursorWithMask normal asCursorForm.
!

----- Method: HandMorph class>>newEventRules: (in category 'utilities') -----
newEventRules: aBool
	NewEventRules := aBool.!

----- Method: HandMorph class>>showEvents: (in category 'utilities') -----
showEvents: aBool
	"HandMorph showEvents: true"
	"HandMorph showEvents: false"
	ShowEvents := aBool.
	aBool ifFalse: [ ActiveWorld invalidRect: (0 at 0 extent: 250 at 120) ].!

----- Method: HandMorph class>>startUp (in category 'initialization') -----
startUp

	self clearCompositionWindowManager.
	self clearInterpreters.
!

----- Method: HandMorph>>addEventListener: (in category 'listeners') -----
addEventListener: anObject
	"Make anObject a listener for all events. All events will be reported to the object."
	self eventListeners: (self addListener: anObject to: self eventListeners)!

----- Method: HandMorph>>addKeyboardListener: (in category 'listeners') -----
addKeyboardListener: anObject
	"Make anObject a listener for keyboard events. All keyboard events will be reported to the object."
	self keyboardListeners: (self addListener: anObject to: self keyboardListeners)!

----- Method: HandMorph>>addListener:to: (in category 'listeners') -----
addListener: anObject to: aListenerGroup
	"Add anObject to the given listener group. Return the new group."
	| listeners |
	listeners := aListenerGroup.
	(listeners notNil and:[listeners includes: anObject]) ifFalse:[
		listeners
			ifNil:[listeners := WeakArray with: anObject]
			ifNotNil:[listeners := listeners copyWith: anObject]].
	listeners := listeners copyWithout: nil. "obsolete entries"
	^listeners!

----- Method: HandMorph>>addMouseListener: (in category 'listeners') -----
addMouseListener: anObject
	"Make anObject a listener for mouse events. All mouse events will be reported to the object."
	self mouseListeners: (self addListener: anObject to: self mouseListeners)!

----- Method: HandMorph>>anyButtonPressed (in category 'accessing') -----
anyButtonPressed
	^lastMouseEvent anyButtonPressed!

----- Method: HandMorph>>attachMorph: (in category 'grabbing/dropping') -----
attachMorph: m
	"Position the center of the given morph under this hand, then grab it.
	This method is used to grab far away or newly created morphs."
	| delta |
	self releaseMouseFocus. "Break focus"
	delta := m bounds extent // 2.
	m position: (self position - delta).
	m formerPosition: m position.
	targetOffset := m position - self position.
	self addMorphBack: m.!

----- Method: HandMorph>>autoFocusRectangleBoundsFor: (in category 'genie-stubs') -----
autoFocusRectangleBoundsFor: aMorph
	^aMorph bounds!

----- Method: HandMorph>>balloonHelp (in category 'balloon help') -----
balloonHelp
	"Return the balloon morph associated with this hand"
	^self valueOfProperty: #balloonHelpMorph!

----- Method: HandMorph>>balloonHelp: (in category 'balloon help') -----
balloonHelp: aBalloonMorph
	"Return the balloon morph associated with this hand"
	| oldHelp |
	oldHelp := self balloonHelp.
	oldHelp ifNotNil:[oldHelp delete].
	aBalloonMorph
		ifNil:[self removeProperty: #balloonHelpMorph]
		ifNotNil:[self setProperty: #balloonHelpMorph toValue: aBalloonMorph]!

----- Method: HandMorph>>changed (in category 'updating') -----
changed

	hasChanged := true.
!

----- Method: HandMorph>>checkForMoreKeyboard (in category 'event handling') -----
checkForMoreKeyboard
	"Quick check for more keyboard activity -- Allows, eg, many characters
	to be accumulated into a single replacement during type-in."

	| evtBuf |
	self flag: #arNote.	"Will not work if we don't examine event queue in Sensor"
	evtBuf := Sensor peekKeyboardEvent.
	evtBuf ifNil: [^nil].
	^self generateKeyboardEvent: evtBuf!

----- Method: HandMorph>>clearKeyboardInterpreter (in category 'multilingual') -----
clearKeyboardInterpreter

	keyboardInterpreter := nil.
!

----- Method: HandMorph>>colorForInsets (in category 'accessing') -----
colorForInsets
	"Morphs being dragged by the hand use the world's color"
	^ owner colorForInsets!

----- Method: HandMorph>>compositionWindowManager (in category 'focus handling') -----
compositionWindowManager

	^ self class compositionWindowManager.
!

----- Method: HandMorph>>copyToPasteBuffer: (in category 'meta-actions') -----
copyToPasteBuffer: aMorph
	"Save this morph in the paste buffer. This is mostly useful for copying morphs between projects."
	aMorph ifNil:[^PasteBuffer := nil].
	Cursor wait showWhile:[
		PasteBuffer := aMorph topRendererOrSelf veryDeepCopy.
		PasteBuffer privateOwner: nil].

!

----- Method: HandMorph>>cursorBounds (in category 'cursor') -----
cursorBounds

	^temporaryCursor 
		ifNil: [self position extent: NormalCursor extent]
		ifNotNil: [self position + temporaryCursorOffset extent: temporaryCursor extent]!

----- Method: HandMorph>>cursorPoint (in category 'event handling') -----
cursorPoint
	"Implemented for allowing embedded worlds in an event cycle to query a hand's position and get it in its coordinates. The same can be achieved by #point:from: but this is simply much more convenient since it will look as if the hand is in the lower world."

	| pos |
	pos := self position.
	(ActiveWorld isNil or: [ActiveWorld == owner]) ifTrue: [^pos].
	^ActiveWorld point: pos from: owner!

----- Method: HandMorph>>deleteBalloonTarget: (in category 'balloon help') -----
deleteBalloonTarget: aMorph
	"Delete any existing balloon help.  This is now done unconditionally, whether or not the morph supplied is the same as the current balloon target"
	
	self balloonHelp: nil

"	| h |
	h := self balloonHelp ifNil: [^ self].
	h balloonOwner == aMorph ifTrue: [self balloonHelp: nil]"!

----- Method: HandMorph>>disableGenieFocus (in category 'genie-stubs') -----
disableGenieFocus
!

----- Method: HandMorph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas 
	"Draw the hand itself (i.e., the cursor)."

	| userPic |
	temporaryCursor isNil 
		ifTrue: [aCanvas paintImage: NormalCursor at: bounds topLeft]
		ifFalse: [aCanvas paintImage: temporaryCursor at: bounds topLeft].
	self hasUserInformation 
		ifTrue: 
			[aCanvas 
				drawString: userInitials
				at: self cursorBounds topRight + (0 @ 4)
				font: nil
				color: color.
			(userPic := self userPicture) ifNotNil: 
					[aCanvas paintImage: userPic at: self cursorBounds topRight + (0 @ 24)]]!

----- Method: HandMorph>>dropMorph:event: (in category 'grabbing/dropping') -----
dropMorph: aMorph event: anEvent
	"Drop the given morph which was carried by the hand"
	| event dropped |
	(anEvent isMouseUp and:[aMorph shouldDropOnMouseUp not]) ifTrue:[^self].

	"Note: For robustness in drag and drop handling we remove the morph BEFORE we drop him, but we keep his owner set to the hand. This prevents system lockups when there is a problem in drop handling (for example if there's an error in #wantsToBeDroppedInto:). THIS TECHNIQUE IS NOT RECOMMENDED FOR CASUAL USE."
	self privateRemove: aMorph.
	aMorph privateOwner: self.

	dropped := aMorph.
	(dropped hasProperty: #addedFlexAtGrab) 
		ifTrue:[dropped := aMorph removeFlexShell].
	event := DropEvent new setPosition: self position contents: dropped hand: self.
	self sendEvent: event focus: nil.
	event wasHandled ifFalse:[aMorph rejectDropMorphEvent: event].
	aMorph owner == self ifTrue:[aMorph delete].
	self mouseOverHandler processMouseOver: anEvent.!

----- Method: HandMorph>>dropMorphs (in category 'grabbing/dropping') -----
dropMorphs
	"Drop the morphs at the hands position"
	self dropMorphs: lastMouseEvent.!

----- Method: HandMorph>>dropMorphs: (in category 'grabbing/dropping') -----
dropMorphs: anEvent
	"Drop the morphs at the hands position"
	self submorphsReverseDo:[:m|
		"Drop back to front to maintain z-order"
		self dropMorph: m event: anEvent.
	].!

----- Method: HandMorph>>enableGenie (in category 'genie-stubs') -----
enableGenie
	self error: 'Genie is not available for this hand'.!

----- Method: HandMorph>>eventListeners (in category 'listeners') -----
eventListeners
	^eventListeners!

----- Method: HandMorph>>eventListeners: (in category 'listeners') -----
eventListeners: anArrayOrNil
	eventListeners := anArrayOrNil!

----- Method: HandMorph>>flushEvents (in category 'event handling') -----
flushEvents
	"Flush any events that may be pending"
	self flag: #arNote. "Remove it and fix senders"
	Sensor flushEvents.!

----- Method: HandMorph>>focusStartEvent (in category 'genie-stubs') -----
focusStartEvent
	^nil!

----- Method: HandMorph>>fullBounds (in category 'layout') -----
fullBounds
	"Extend my bounds by the shadow offset when carrying morphs."

	| bnds |
	bnds := super fullBounds.
	submorphs isEmpty
		ifTrue: [^ bnds ]
		ifFalse: [^ bnds topLeft corner: bnds bottomRight + self shadowOffset].
!

----- Method: HandMorph>>fullDrawOn: (in category 'drawing') -----
fullDrawOn: aCanvas 
	"A HandMorph has unusual drawing requirements:
		1. the hand itself (i.e., the cursor) appears in front of its submorphs
		2. morphs being held by the hand cast a shadow on the world/morphs below
	The illusion is that the hand plucks up morphs and carries them above the world."

	"Note: This version caches an image of the morphs being held by the hand for
	 better performance. This cache is invalidated if one of those morphs changes."

	| disableCaching subBnds roundCorners rounded |
	self visible ifFalse: [^self].
	(aCanvas isVisible: self fullBounds) ifFalse: [^self].
	disableCaching := false.
	disableCaching 
		ifTrue: 
			[self nonCachingFullDrawOn: aCanvas.
			^self].
	submorphs isEmpty 
		ifTrue: 
			[cacheCanvas := nil.
			^self drawOn: aCanvas].	"just draw the hand itself"
	subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	self updateCacheCanvas: aCanvas.
	(cacheCanvas isNil 
		or: [cachedCanvasHasHoles and: [cacheCanvas depth = 1]]) 
			ifTrue: 
				["could not use caching due to translucency; do full draw"

				self nonCachingFullDrawOn: aCanvas.
				^self].

	"--> begin rounded corners hack <---"
	roundCorners := cachedCanvasHasHoles == false 
				and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]].
	roundCorners 
		ifTrue: 
			[rounded := submorphs first.
			aCanvas asShadowDrawingCanvas translateBy: self shadowOffset
				during: 
					[:shadowCanvas | 
					shadowCanvas roundCornersOf: rounded
						during: 
							[(subBnds areasOutside: (rounded boundsWithinCorners 
										translateBy: self shadowOffset negated)) 
								do: [:r | shadowCanvas fillRectangle: r color: Color black]]].
			aCanvas roundCornersOf: rounded
				during: 
					[aCanvas 
						drawImage: cacheCanvas form
						at: subBnds origin
						sourceRect: cacheCanvas form boundingBox].
			^self drawOn: aCanvas	"draw the hand itself in front of morphs"].
	"--> end rounded corners hack <---"

	"draw the shadow"
	aCanvas asShadowDrawingCanvas translateBy: self shadowOffset
		during: 
			[:shadowCanvas | 
			cachedCanvasHasHoles 
				ifTrue: 
					["Have to draw the real shadow of the form"

					shadowCanvas paintImage: cacheCanvas form at: subBnds origin]
				ifFalse: 
					["Much faster if only have to shade the edge of a solid rectangle"

					(subBnds areasOutside: (subBnds translateBy: self shadowOffset negated)) 
						do: [:r | shadowCanvas fillRectangle: r color: Color black]]].

	"draw morphs in front of the shadow using the cached Form"
	cachedCanvasHasHoles 
		ifTrue: [aCanvas paintImage: cacheCanvas form at: subBnds origin]
		ifFalse: 
			[aCanvas 
				drawImage: cacheCanvas form
				at: subBnds origin
				sourceRect: cacheCanvas form boundingBox].
	self drawOn: aCanvas	"draw the hand itself in front of morphs"!

----- Method: HandMorph>>generateDropFilesEvent: (in category 'private events') -----
generateDropFilesEvent: evtBuf 
	"Generate the appropriate mouse event for the given raw event buffer"

	"Note: This is still in an experimental phase and will need more work"

	| position buttons modifiers stamp numFiles dragType |
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	dragType := evtBuf third.
	position := evtBuf fourth @ evtBuf fifth.
	buttons := 0.
	modifiers := evtBuf sixth.
	buttons := buttons bitOr: (modifiers bitShift: 3).
	numFiles := evtBuf seventh.
	dragType = 4 
		ifTrue: 
			["e.g., drop"

			owner borderWidth: 0.
			^DropFilesEvent new 
				setPosition: position
				contents: numFiles
				hand: self].
	"the others are currently not handled by morphs themselves"
	dragType = 1 
		ifTrue: 
			["experimental drag enter"

			owner
				borderWidth: 4;
				borderColor: owner color asColor negated].
	dragType = 2 
		ifTrue: 
			["experimental drag move"

			].
	dragType = 3 
		ifTrue: 
			["experimental drag leave"

			owner borderWidth: 0].
	^nil!

----- Method: HandMorph>>generateKeyboardEvent: (in category 'private events') -----
generateKeyboardEvent: evtBuf
	"Generate the appropriate mouse event for the given raw event buffer"

	| buttons modifiers type pressType stamp char |
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	pressType := evtBuf fourth.
	pressType = EventKeyDown ifTrue: [type := #keyDown].
	pressType = EventKeyUp ifTrue: [type := #keyUp].
	pressType = EventKeyChar ifTrue: [type := #keystroke].
	modifiers := evtBuf fifth.
	buttons := modifiers bitShift: 3.
	char := self keyboardInterpreter nextCharFrom: Sensor firstEvt: evtBuf.
	^ KeyboardEvent new
		setType: type
		buttons: buttons
		position: self position
		keyValue: char asciiValue
		hand: self
		stamp: stamp.
!

----- Method: HandMorph>>generateMouseEvent: (in category 'private events') -----
generateMouseEvent: evtBuf 
	"Generate the appropriate mouse event for the given raw event buffer"

	| position buttons modifiers type trail stamp oldButtons evtChanged |
	evtBuf first = lastEventBuffer first 
		ifTrue: 
			["Workaround for Mac VM bug, *always* generating 3 events on clicks"

			evtChanged := false.
			3 to: evtBuf size
				do: [:i | (lastEventBuffer at: i) = (evtBuf at: i) ifFalse: [evtChanged := true]].
			evtChanged ifFalse: [^nil]].
	stamp := evtBuf second.
	stamp = 0 ifTrue: [stamp := Time millisecondClockValue].
	position := evtBuf third @ evtBuf fourth.
	buttons := evtBuf fifth.
	modifiers := evtBuf sixth.
	type := buttons = 0 
		ifTrue: 
			[lastEventBuffer fifth = 0 ifTrue: [#mouseMove] ifFalse: [#mouseUp]]
		ifFalse: 
			[lastEventBuffer fifth = 0 
						ifTrue: [#mouseDown]
						ifFalse: [#mouseMove]].
	buttons := buttons bitOr: (modifiers bitShift: 3).
	oldButtons := lastEventBuffer fifth 
				bitOr: (lastEventBuffer sixth bitShift: 3).
	lastEventBuffer := evtBuf.
	type == #mouseMove 
		ifTrue: 
			[trail := self mouseTrailFrom: evtBuf.
			^MouseMoveEvent new 
				setType: type
				startPoint: (self position)
				endPoint: trail last
				trail: trail
				buttons: buttons
				hand: self
				stamp: stamp].
	^MouseButtonEvent new 
		setType: type
		position: position
		which: (oldButtons bitXor: buttons)
		buttons: buttons
		hand: self
		stamp: stamp!

----- Method: HandMorph>>generateWindowEvent: (in category 'private events') -----
generateWindowEvent: evtBuf 
	"Generate the appropriate window event for the given raw event buffer"

	| evt |
	evt := WindowEvent new.
	evt setTimeStamp: evtBuf second.
	evt timeStamp = 0 ifTrue: [evt setTimeStamp: Time millisecondClockValue].
	evt action: evtBuf third.
	evt rectangle: (Rectangle origin: evtBuf fourth @ evtBuf fifth corner: evtBuf sixth @ evtBuf seventh ).
	
	^evt!

----- Method: HandMorph>>genieGestureProcessor (in category 'genie-stubs') -----
genieGestureProcessor
	^nil!

----- Method: HandMorph>>grabMorph: (in category 'meta-actions') -----
grabMorph: aMorph
	"Grab the given morph (i.e., add it to this hand and remove it from its current owner) without changing its position. This is used to pick up a morph under the hand's current position, versus attachMorph: which is used to pick up a morph that may not be near this hand."
	| grabbed |
	self releaseMouseFocus. "Break focus"
	grabbed := aMorph aboutToBeGrabbedBy: self.
	grabbed ifNil:[^self].
	grabbed := grabbed topRendererOrSelf.
	^self grabMorph: grabbed from: grabbed owner!

----- Method: HandMorph>>grabMorph:from: (in category 'grabbing/dropping') -----
grabMorph: aMorph from: formerOwner
	"Grab the given morph (i.e., add it to this hand and remove it from its current owner) without changing its position. This is used to pick up a morph under the hand's current position, versus attachMorph: which is used to pick up a morph that may not be near this hand."

	| grabbed offset targetPoint grabTransform fullTransform |
	self releaseMouseFocus. "Break focus"
	grabbed := aMorph.
	aMorph keepsTransform ifTrue:[
		grabTransform := fullTransform := IdentityTransform new.
	] ifFalse:[
		"Compute the transform to apply to the grabbed morph"
		grabTransform := formerOwner 
			ifNil:		[IdentityTransform new] 
			ifNotNil:	[formerOwner grabTransform].
		"Compute the full transform for the grabbed morph"
		fullTransform := formerOwner 
			ifNil:		[IdentityTransform new] 
			ifNotNil:	[formerOwner transformFrom: owner].
	].
	"targetPoint is point in aMorphs reference frame"
	targetPoint := fullTransform globalPointToLocal: self position.
	"but current position will be determined by grabTransform, so compute offset"
	offset := targetPoint - (grabTransform globalPointToLocal: self position).
	"apply the transform that should be used after grabbing"
	grabbed := grabbed transformedBy: grabTransform.
	grabbed == aMorph 
		ifFalse:	[grabbed setProperty: #addedFlexAtGrab toValue: true].
	"offset target to compensate for differences in transforms"
	grabbed position: grabbed position - offset asIntegerPoint.
	"And compute distance from hand's position"
	targetOffset := grabbed position - self position.
	self addMorphBack: grabbed.
	grabbed justGrabbedFrom: formerOwner.!

----- Method: HandMorph>>halo (in category 'halos and balloon help') -----
halo
	"Return the halo associated with this hand, if any"
	^self valueOfProperty: #halo!

----- Method: HandMorph>>halo: (in category 'halo handling') -----
halo: newHalo
	"Set halo associated with this hand"
	| oldHalo |
	oldHalo := self halo.
	(oldHalo isNil or:[oldHalo == newHalo]) ifFalse:[oldHalo delete].
	newHalo
		ifNil:[self removeProperty: #halo]
		ifNotNil:[self setProperty: #halo toValue: newHalo]!

----- Method: HandMorph>>handleEvent: (in category 'events-processing') -----
handleEvent: anEvent
	| evt ofs |
	owner ifNil:[^self].
	evt := anEvent.

	EventStats ifNil:[EventStats := IdentityDictionary new].
	EventStats at: #count put: (EventStats at: #count ifAbsent:[0]) + 1.
	EventStats at: evt type put: (EventStats at: evt type ifAbsent:[0]) + 1.

	evt isMouseOver ifTrue:[^self sendMouseEvent: evt].

ShowEvents == true ifTrue:[
	Display fill: (0 at 0 extent: 250 at 120) rule: Form over fillColor: Color white.
	ofs := (owner hands indexOf: self) - 1 * 60.
	evt printString displayAt: (0 at ofs) + (evt isKeyboard ifTrue:[0 at 30] ifFalse:[0 at 0]).
	self keyboardFocus printString displayAt: (0 at ofs)+(0 at 45).
].
	"Notify listeners"
	self sendListenEvent: evt to: self eventListeners.

	evt isWindowEvent ifTrue: [
		self sendEvent: evt focus: nil.
		^self mouseOverHandler processMouseOver: lastMouseEvent].

	evt isKeyboard ifTrue:[
		self sendListenEvent: evt to: self keyboardListeners.
		self sendKeyboardEvent: evt.
		^self mouseOverHandler processMouseOver: lastMouseEvent].

	evt isDropEvent ifTrue:[
		self sendEvent: evt focus: nil.
		^self mouseOverHandler processMouseOver: lastMouseEvent].

	evt isMouse ifTrue:[
		self sendListenEvent: evt to: self mouseListeners.
		lastMouseEvent := evt].

	"Check for pending drag or double click operations."
	mouseClickState ifNotNil:[
		(mouseClickState handleEvent: evt from: self) ifFalse:[
			"Possibly dispatched #click: or something and will not re-establish otherwise"
			^self mouseOverHandler processMouseOver: lastMouseEvent]].

	evt isMove ifTrue:[
		self position: evt position.
		self sendMouseEvent: evt.
	] ifFalse:[
		"Issue a synthetic move event if we're not at the position of the event"
		(evt position = self position) ifFalse:[self moveToEvent: evt].
		"Drop submorphs on button events"
		(self hasSubmorphs) 
			ifTrue:[self dropMorphs: evt]
			ifFalse:[self sendMouseEvent: evt].
	].
	ShowEvents == true ifTrue:[self mouseFocus printString displayAt: (0 at ofs) + (0 at 15)].
	self mouseOverHandler processMouseOver: lastMouseEvent.
	"self handleDragOutside: anEvent."
!

----- Method: HandMorph>>hasChanged (in category 'drawing') -----
hasChanged
	"Return true if this hand has changed, either because it has moved or because some morph it is holding has changed."

	^ hasChanged ifNil: [ true ]
!

----- Method: HandMorph>>hasUserInformation (in category 'drawing') -----
hasUserInformation
	^self userInitials notEmpty or: [self userPicture notNil]!

----- Method: HandMorph>>initForEvents (in category 'initialization') -----
initForEvents
	mouseOverHandler := nil.
	lastMouseEvent := MouseEvent new setType: #mouseMove position: 0 at 0 buttons: 0 hand: self.
	lastEventBuffer := {1. 0. 0. 0. 0. 0. nil. nil}.
	self resetClickState.!

----- Method: HandMorph>>initialize (in category 'initialization') -----
initialize
	super initialize.
	self initForEvents.
	keyboardFocus := nil.
	mouseFocus := nil.
	bounds := 0 at 0 extent: Cursor normal extent.
	userInitials := ''.
	damageRecorder := DamageRecorder new.
	cachedCanvasHasHoles := false.
	temporaryCursor := temporaryCursorOffset := nil.
	self initForEvents.!

----- Method: HandMorph>>interrupted (in category 'initialization') -----
interrupted
	"Something went wrong - we're about to bring up a debugger. 
	Release some stuff that could be problematic."
	self releaseAllFoci. "or else debugger might not handle clicks"
!

----- Method: HandMorph>>invalidRect:from: (in category 'change reporting') -----
invalidRect: damageRect from: aMorph
	"Note that a change has occurred and record the given damage rectangle relative to the origin this hand's cache."
	hasChanged := true.
	aMorph == self ifTrue:[^self].
	damageRecorder recordInvalidRect: damageRect.
!

----- Method: HandMorph>>isCapturingGesturePoints (in category 'events-processing') -----
isCapturingGesturePoints
	^false!

----- Method: HandMorph>>isGenieAvailable (in category 'genie-stubs') -----
isGenieAvailable
	"Answer whether the Genie gesture recognizer is available for this hand"
	^false!

----- Method: HandMorph>>isGenieEnabled (in category 'genie-stubs') -----
isGenieEnabled
	"Answer whether the Genie gesture recognizer is enabled for this hand"
	^false!

----- Method: HandMorph>>isGenieFocused (in category 'genie-stubs') -----
isGenieFocused
	"Answer whether the Genie gesture recognizer is auto-focused for this hand"
	^false!

----- Method: HandMorph>>isHandMorph (in category 'classification') -----
isHandMorph

	^ true!

----- Method: HandMorph>>keyboardFocus (in category 'focus handling') -----
keyboardFocus 
	^ keyboardFocus!

----- Method: HandMorph>>keyboardFocus: (in category 'focus handling') -----
keyboardFocus: aMorphOrNil
	keyboardFocus := aMorphOrNil!

----- Method: HandMorph>>keyboardInterpreter (in category 'multilingual') -----
keyboardInterpreter

	^keyboardInterpreter ifNil: [keyboardInterpreter := LanguageEnvironment currentPlatform class defaultInputInterpreter]!

----- Method: HandMorph>>keyboardListeners (in category 'listeners') -----
keyboardListeners
	^keyboardListeners!

----- Method: HandMorph>>keyboardListeners: (in category 'listeners') -----
keyboardListeners: anArrayOrNil
	keyboardListeners := anArrayOrNil!

----- Method: HandMorph>>lastEvent (in category 'accessing') -----
lastEvent
	^ lastMouseEvent!

----- Method: HandMorph>>mouseFocus (in category 'focus handling') -----
mouseFocus
	^mouseFocus!

----- Method: HandMorph>>mouseFocus: (in category 'focus handling') -----
mouseFocus: aMorphOrNil
	mouseFocus := aMorphOrNil!

----- Method: HandMorph>>mouseListeners (in category 'listeners') -----
mouseListeners
	^mouseListeners!

----- Method: HandMorph>>mouseListeners: (in category 'listeners') -----
mouseListeners: anArrayOrNil
	mouseListeners := anArrayOrNil!

----- Method: HandMorph>>mouseOverHandler (in category 'accessing') -----
mouseOverHandler
	^mouseOverHandler ifNil:[mouseOverHandler := MouseOverHandler new].!

----- Method: HandMorph>>mouseTrailFrom: (in category 'private events') -----
mouseTrailFrom: currentBuf 
	"Current event, a mouse event buffer, is about to be processed.  If there are other similar mouse events queued up, then drop them from the queue, and report the positions inbetween."

	| nextEvent trail |
	trail := WriteStream on: (Array new: 1).
	trail nextPut: currentBuf third @ currentBuf fourth.
	[(nextEvent := Sensor peekEvent) isNil] whileFalse: 
			[nextEvent first = currentBuf first 
				ifFalse: [^trail contents	"different event type"].
			nextEvent fifth = currentBuf fifth 
				ifFalse: [^trail contents	"buttons changed"].
			nextEvent sixth = currentBuf sixth 
				ifFalse: [^trail contents	"modifiers changed"].
			"nextEvent is similar.  Remove it from the queue, and check the next."
			nextEvent := Sensor nextEvent.
			trail nextPut: nextEvent third @ nextEvent fourth].
	^trail contents!

----- Method: HandMorph>>moveToEvent: (in category 'private events') -----
moveToEvent: anEvent
	"Issue a mouse move event to make the receiver appear at the given position"
	self handleEvent: (MouseMoveEvent new
		setType: #mouseMove 
		startPoint: self position 
		endPoint: anEvent position 
		trail: (Array with: self position with: anEvent position)
		buttons: anEvent buttons
		hand: self
		stamp: anEvent timeStamp)!

----- Method: HandMorph>>needsToBeDrawn (in category 'drawing') -----
needsToBeDrawn
	"Return true if this hand must be drawn explicitely instead of being drawn via the hardware cursor. This is the case if it (a) it is a remote hand, (b) it is showing a temporary cursor, or (c) it is not empty and there are any visible submorphs. If using the software cursor, ensure that the hardware cursor is hidden."
	"Details:  Return true if this hand has a saved patch to ensure that is is processed by the world. This saved patch will be deleted after one final display pass when it becomes possible to start using the hardware cursor again. This trick gives us one last display cycle to allow us to remove the software cursor and shadow from the display."
	(savedPatch notNil
		or: [ (submorphs anySatisfy: [ :ea | ea visible ])
			or: [ (temporaryCursor notNil and: [hardwareCursor isNil])
				or: [ self hasUserInformation ]]])
		ifTrue: [
			"using the software cursor; hide the hardware one"
			self showHardwareCursor: false.
			^ true].
	^ false
!

----- Method: HandMorph>>newKeyboardFocus: (in category 'focus handling') -----
newKeyboardFocus: aMorphOrNil
	"Make the given morph the new keyboard focus, canceling the previous keyboard focus if any. If the argument is nil, the current keyboard focus is cancelled."
	| oldFocus |
	oldFocus := self keyboardFocus.
	self keyboardFocus: aMorphOrNil.
	oldFocus ifNotNil: [oldFocus == aMorphOrNil ifFalse: [oldFocus keyboardFocusChange: false]].
	aMorphOrNil ifNotNil: [aMorphOrNil keyboardFocusChange: true. self compositionWindowManager keyboardFocusForAMorph: aMorphOrNil].
!

----- Method: HandMorph>>newMouseFocus: (in category 'focus handling') -----
newMouseFocus: aMorphOrNil
	"Make the given morph the new mouse focus, canceling the previous mouse focus if any. If the argument is nil, the current mouse focus is cancelled."
	self mouseFocus: aMorphOrNil.
!

----- Method: HandMorph>>newMouseFocus:event: (in category 'focus handling') -----
newMouseFocus: aMorph event: event 
	aMorph isNil 
		ifFalse: [targetOffset := event cursorPoint - aMorph position].
	^self newMouseFocus: aMorph!

----- Method: HandMorph>>noButtonPressed (in category 'accessing') -----
noButtonPressed
	"Answer whether any mouse button is not being pressed."

	^self anyButtonPressed not!

----- Method: HandMorph>>nonCachingFullDrawOn: (in category 'drawing') -----
nonCachingFullDrawOn: aCanvas
	
	"A HandMorph has unusual drawing requirements:
		1. the hand itself (i.e., the cursor) appears in front of its submorphs
		2. morphs being held by the hand cast a shadow on the world/morphs below
	The illusion is that the hand plucks up morphs and carries them above the world."
	"Note: This version does not cache an image of the morphs being held by the hand.
	 Thus, it is slower for complex morphs, but consumes less space."

	submorphs isEmpty ifTrue: [^ self drawOn: aCanvas].  "just draw the hand itself"
	aCanvas asShadowDrawingCanvas
		translateBy: self shadowOffset during:[:shadowCanvas| | shadowForm |
		"Note: We use a shadow form here to prevent drawing
		overlapping morphs multiple times using the transparent
		shadow color."
		shadowForm := self shadowForm.
"
shadowForm displayAt: shadowForm offset negated. Display forceToScreen: (0 at 0 extent: shadowForm extent).
"
		shadowCanvas paintImage: shadowForm at: shadowForm offset.  "draw shadows"
	].
	"draw morphs in front of shadows"
	self drawSubmorphsOn: aCanvas.
	self drawOn: aCanvas.  "draw the hand itself in front of morphs"
!

----- Method: HandMorph>>noticeMouseOver:event: (in category 'event handling') -----
noticeMouseOver: aMorph event: anEvent
	mouseOverHandler ifNil:[^self].
	mouseOverHandler noticeMouseOver: aMorph event: anEvent.!

----- Method: HandMorph>>objectForDataStream: (in category 'objects from disk') -----
objectForDataStream: refStrm
	| dp |
	"I am about to be written on an object file.  Write a path to me in the other system instead."

	(refStrm project world hands includes: self) ifTrue: [
		^ self].	"owned by the project"
	dp := DiskProxy global: #World selector: #primaryHand args: #().
	refStrm replace: self with: dp.
	^ dp
	"Note, when this file is loaded in an MVC project, this will return nil.  The MenuItemMorph that has this in a field will have that item not work.  Maybe warn the user at load time?"!

----- Method: HandMorph>>objectToPaste (in category 'paste buffer') -----
objectToPaste
	"It may need to be sent #startRunning by the client"
	^ Cursor wait showWhile: [PasteBuffer veryDeepCopy]

	"PasteBuffer usableDuplicateIn: self world"
!

----- Method: HandMorph>>obtainHalo: (in category 'halo handling') -----
obtainHalo: aHalo
	"Used for transfering halos between hands"
	| formerOwner |
	self halo == aHalo ifTrue:[^self].
	"Find former owner"
	formerOwner := self world hands detect:[:h| h halo == aHalo] ifNone:[nil].
	formerOwner ifNotNil:[formerOwner releaseHalo: aHalo].
	self halo: aHalo!

----- Method: HandMorph>>pasteBuffer (in category 'paste buffer') -----
pasteBuffer
	"Return the paste buffer associated with this hand"
	^ PasteBuffer!

----- Method: HandMorph>>pasteBuffer: (in category 'paste buffer') -----
pasteBuffer: aMorphOrNil
	"Set the contents of the paste buffer."
	PasteBuffer := aMorphOrNil.

!

----- Method: HandMorph>>pasteMorph (in category 'paste buffer') -----
pasteMorph

	| aPastee |
	PasteBuffer ifNil: [^ self inform: 'Nothing to paste.' translated].
	self attachMorph: (aPastee := self objectToPaste).
	aPastee align: aPastee center with: self position.
	aPastee player ifNotNil: [aPastee player startRunning]
!

----- Method: HandMorph>>pauseEventRecorderIn: (in category 'event handling') -----
pauseEventRecorderIn: aWorld
	"Suspend any recorder prior to a project change, and return it.
	It will be resumed after starting the new project."
	eventListeners ifNil:[^nil].
	eventListeners do:
		[:er | (er isKindOf: EventRecorderMorph) ifTrue: [^ er pauseIn: aWorld]].
	^ nil!

----- Method: HandMorph>>position (in category 'geometry') -----
position

	^temporaryCursor
		ifNil: [bounds topLeft]
		ifNotNil: [bounds topLeft - temporaryCursorOffset]!

----- Method: HandMorph>>position: (in category 'geometry') -----
position: aPoint
	"Overridden to align submorph origins to the grid if gridding is on."
	| adjustedPosition delta box |
	adjustedPosition := aPoint.
	temporaryCursor ifNotNil: [adjustedPosition := adjustedPosition + temporaryCursorOffset].

	"Copied from Morph to avoid owner layoutChanged"
	"Change the position of this morph and and all of its submorphs."
	delta := adjustedPosition - bounds topLeft.
	(delta x = 0 and: [delta y = 0]) ifTrue: [^ self].  "Null change"
	box := self fullBounds.
	(delta dotProduct: delta) > 100 ifTrue:[
		"e.g., more than 10 pixels moved"
		self invalidRect: box.
		self invalidRect: (box translateBy: delta).
	] ifFalse:[
		self invalidRect: (box merge: (box translateBy: delta)).
	].
	self privateFullMoveBy: delta.
!

----- Method: HandMorph>>processEvents (in category 'event handling') -----
processEvents
	"Process user input events from the local input devices."

	| evt evtBuf type hadAny |
	ActiveEvent ifNotNil: 
			["Meaning that we were invoked from within an event response.
		Make sure z-order is up to date"

			self mouseOverHandler processMouseOver: lastMouseEvent].
	hadAny := false.
	[(evtBuf := Sensor nextEvent) isNil] whileFalse: 
			[evt := nil.	"for unknown event types"
			type := evtBuf first.
			type = EventTypeMouse ifTrue: [evt := self generateMouseEvent: evtBuf].
			type = EventTypeKeyboard 
				ifTrue: [evt := self generateKeyboardEvent: evtBuf].
			type = EventTypeDragDropFiles 
				ifTrue: [evt := self generateDropFilesEvent: evtBuf].
			type = EventTypeWindow
				ifTrue:[evt := self generateWindowEvent: evtBuf].
			"All other events are ignored"
			(type ~= EventTypeDragDropFiles and: [evt isNil]) ifTrue: [^self].
			evt isNil 
				ifFalse: 
					["Finally, handle it"

					self handleEvent: evt.
					hadAny := true.

					"For better user feedback, return immediately after a mouse event has been processed."
					evt isMouse ifTrue: [^self]]].
	"note: if we come here we didn't have any mouse events"
	mouseClickState notNil 
		ifTrue: 
			["No mouse events during this cycle. Make sure click states time out accordingly"

			mouseClickState handleEvent: lastMouseEvent asMouseMove from: self].
	hadAny 
		ifFalse: 
			["No pending events. Make sure z-order is up to date"

			self mouseOverHandler processMouseOver: lastMouseEvent]!

----- Method: HandMorph>>releaseAllFoci (in category 'focus handling') -----
releaseAllFoci
	mouseFocus := nil.
	keyboardFocus := nil.
!

----- Method: HandMorph>>releaseCachedState (in category 'caching') -----
releaseCachedState
	| oo ui |
	ui := userInitials.
	super releaseCachedState.
	cacheCanvas := nil.
	oo := owner.
	self removeAllMorphs.
	self initialize.	"nuke everything"
	self privateOwner: oo.
	self releaseAllFoci.
	self userInitials: ui andPicture: (self userPicture).!

----- Method: HandMorph>>releaseHalo: (in category 'halo handling') -----
releaseHalo: aHalo
	"Used for transfering halos between hands"
	self removeProperty: #halo!

----- Method: HandMorph>>releaseKeyboardFocus (in category 'focus handling') -----
releaseKeyboardFocus
	"Release the current keyboard focus unconditionally"
	self newKeyboardFocus: nil.
!

----- Method: HandMorph>>releaseKeyboardFocus: (in category 'focus handling') -----
releaseKeyboardFocus: aMorph
	"If the given morph had the keyboard focus before, release it"
	self keyboardFocus == aMorph ifTrue:[self releaseKeyboardFocus].!

----- Method: HandMorph>>releaseMouseFocus (in category 'focus handling') -----
releaseMouseFocus
	"Release the current mouse focus unconditionally."
	self newMouseFocus: nil.!

----- Method: HandMorph>>releaseMouseFocus: (in category 'focus handling') -----
releaseMouseFocus: aMorph
	"If the given morph had the mouse focus before, release it"
	self mouseFocus == aMorph ifTrue:[self releaseMouseFocus].!

----- Method: HandMorph>>removeEventListener: (in category 'listeners') -----
removeEventListener: anObject
	"Remove anObject from the current event listeners."
	self eventListeners: (self removeListener: anObject from: self eventListeners).!

----- Method: HandMorph>>removeHalo (in category 'halo handling') -----
removeHalo
	"remove the receiver's halo (if any)"
	| halo |
	halo := self halo.
	halo
		ifNil: [^ self].
	halo delete.
	self removeProperty: #halo!

----- Method: HandMorph>>removeHaloFromClick:on: (in category 'halo handling') -----
removeHaloFromClick: anEvent on: aMorph 
	| halo |
	halo := self halo
				ifNil: [^ self].
	(halo target hasOwner: self)
		ifTrue: [^ self].
	(halo staysUpWhenMouseIsDownIn: aMorph)
		ifFalse: [self removeHalo]!

----- Method: HandMorph>>removeKeyboardListener: (in category 'listeners') -----
removeKeyboardListener: anObject
	"Remove anObject from the current keyboard listeners."
	self keyboardListeners: (self removeListener: anObject from: self keyboardListeners).!

----- Method: HandMorph>>removeListener:from: (in category 'listeners') -----
removeListener: anObject from: aListenerGroup 
	"Remove anObject from the given listener group. Return the new group."

	| listeners |
	aListenerGroup ifNil: [^nil].
	listeners := aListenerGroup.
	listeners := listeners copyWithout: anObject.
	listeners := listeners copyWithout: nil.	"obsolete entries"
	listeners isEmpty ifTrue: [listeners := nil].
	^listeners!

----- Method: HandMorph>>removeMouseListener: (in category 'listeners') -----
removeMouseListener: anObject
	"Remove anObject from the current mouse listeners."
	self mouseListeners: (self removeListener: anObject from: self mouseListeners).!

----- Method: HandMorph>>removePendingBalloonFor: (in category 'balloon help') -----
removePendingBalloonFor: aMorph
	"Get rid of pending balloon help."
	self removeAlarm: #spawnBalloonFor:.
	self deleteBalloonTarget: aMorph.!

----- Method: HandMorph>>removePendingHaloFor: (in category 'halo handling') -----
removePendingHaloFor: aMorph
	"Get rid of pending balloon help or halo actions."
	self removeAlarm: #spawnMagicHaloFor:.!

----- Method: HandMorph>>resetClickState (in category 'double click support') -----
resetClickState
	"Reset the double-click detection state to normal (i.e., not waiting for a double-click)."
	mouseClickState := nil.!

----- Method: HandMorph>>resourceJustLoaded (in category 'initialization') -----
resourceJustLoaded
	"In case resource relates to me"
	cacheCanvas := nil.!

----- Method: HandMorph>>restoreSavedPatchOn: (in category 'drawing') -----
restoreSavedPatchOn: aCanvas 
	"Clear the changed flag and restore the part of the given canvas under this hand from the previously saved patch. If necessary, handle the transition to using the hardware cursor."

	hasChanged := false.
	savedPatch ifNotNil: 
			[aCanvas drawImage: savedPatch at: savedPatch offset.
			self hasUserInformation ifTrue: [^self].	"cannot use hw cursor if so"
			submorphs notEmpty ifTrue: [^self].
			(temporaryCursor notNil and: [hardwareCursor isNil]) ifTrue: [^self].

			"Make the transition to using hardware cursor. Clear savedPatch and
		 report one final damage rectangle to erase the image of the software cursor."
			super invalidRect: (savedPatch offset 
						extent: savedPatch extent + self shadowOffset)
				from: self.
			self showHardwareCursor: true.
			savedPatch := nil]!

----- Method: HandMorph>>savePatchFrom: (in category 'drawing') -----
savePatchFrom: aCanvas 
	"Save the part of the given canvas under this hand as a Form and return its bounding rectangle."

	"Details: The previously used patch Form is recycled when possible to reduce the burden on storage management."

	| damageRect myBnds |
	damageRect := myBnds := self fullBounds.
	savedPatch ifNotNil: 
			[damageRect := myBnds merge: (savedPatch offset extent: savedPatch extent)].
	(savedPatch isNil or: [savedPatch extent ~= myBnds extent]) 
		ifTrue: 
			["allocate new patch form if needed"

			savedPatch := aCanvas form allocateForm: myBnds extent].
	aCanvas contentsOfArea: (myBnds translateBy: aCanvas origin)
		into: savedPatch.
	savedPatch offset: myBnds topLeft.
	^damageRect!

----- Method: HandMorph>>selectedObject (in category 'selected object') -----
selectedObject
	"answer the selected object for the hand or nil is none"
	| halo |
	halo := self halo.
	halo isNil
		ifTrue: [^ nil].
	^ halo target renderedMorph!

----- Method: HandMorph>>sendEvent:focus: (in category 'private events') -----
sendEvent: anEvent focus: focusHolder
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	^self sendEvent: anEvent focus: focusHolder clear:[nil]!

----- Method: HandMorph>>sendEvent:focus:clear: (in category 'private events') -----
sendEvent: anEvent focus: focusHolder clear: aBlock
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	| result |
	focusHolder ifNotNil:[^self sendFocusEvent: anEvent to: focusHolder clear: aBlock].
	ActiveEvent := anEvent.
	result := owner processEvent: anEvent.
	ActiveEvent := nil.
	^result!

----- Method: HandMorph>>sendFocusEvent:to:clear: (in category 'private events') -----
sendFocusEvent: anEvent to: focusHolder clear: aBlock
	"Send the event to the morph currently holding the focus"
	| result w |
	w := focusHolder world ifNil:[^ aBlock value].
	w becomeActiveDuring:[
		ActiveHand := self.
		ActiveEvent := anEvent.
		result := focusHolder handleFocusEvent: 
			(anEvent transformedBy: (focusHolder transformedFrom: self)).
	].
	^result!

----- Method: HandMorph>>sendKeyboardEvent: (in category 'private events') -----
sendKeyboardEvent: anEvent 
	"Send the event to the morph currently holding the focus, or if none to
	the owner of the hand."
	^ self
		sendEvent: anEvent
		focus: self keyboardFocus
		clear: [self keyboardFocus: nil]!

----- Method: HandMorph>>sendListenEvent:to: (in category 'private events') -----
sendListenEvent: anEvent to: listenerGroup
	"Send the event to the given group of listeners"
	listenerGroup ifNil:[^self].
	listenerGroup do:[:listener| 
		listener ifNotNil:[listener handleListenEvent: anEvent copy]].!

----- Method: HandMorph>>sendMouseEvent: (in category 'private events') -----
sendMouseEvent: anEvent
	"Send the event to the morph currently holding the focus, or if none to the owner of the hand."
	^self sendEvent: anEvent focus: self mouseFocus clear:[self mouseFocus: nil]!

----- Method: HandMorph>>shadowForm (in category 'drawing') -----
shadowForm
	"Return a 1-bit shadow of my submorphs.  Assumes submorphs is not empty"
	| bnds canvas |
	bnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	canvas := (Display defaultCanvasClass extent: bnds extent depth: 1) 
		asShadowDrawingCanvas: Color black.
	canvas translateBy: bnds topLeft negated
		during:[:tempCanvas| self drawSubmorphsOn: tempCanvas].
	^ canvas form offset: bnds topLeft!

----- Method: HandMorph>>shadowOffset (in category 'drop shadows') -----
shadowOffset

	^ 6 at 8!

----- Method: HandMorph>>showHardwareCursor: (in category 'drawing') -----
showHardwareCursor: aBool
	"Show/hide the current hardware cursor as indicated."
	| cursor |
	cursor :=  hardwareCursor ifNil:[aBool ifTrue:[Cursor normal] ifFalse:[Cursor blank]].
	Sensor currentCursor == cursor ifFalse: [cursor show].
!

----- Method: HandMorph>>showTemporaryCursor: (in category 'cursor') -----
showTemporaryCursor: cursorOrNil
	"Set the temporary cursor to the given Form. If the argument is nil, revert to the normal cursor."

	self showTemporaryCursor: cursorOrNil hotSpotOffset: 0 at 0
!

----- Method: HandMorph>>showTemporaryCursor:hotSpotOffset: (in category 'cursor') -----
showTemporaryCursor: cursorOrNil hotSpotOffset: hotSpotOffset 
	"Set the temporary cursor to the given Form.
	If the argument is nil, revert to the normal hardware cursor."

	self changed.
	temporaryCursorOffset 
		ifNotNil: [bounds := bounds translateBy: temporaryCursorOffset negated].
	cursorOrNil isNil 
		ifTrue: [temporaryCursor := temporaryCursorOffset := hardwareCursor := nil]
		ifFalse: 
			[temporaryCursor := cursorOrNil asCursorForm.
			temporaryCursorOffset := temporaryCursor offset - hotSpotOffset.
			(cursorOrNil isKindOf: Cursor) ifTrue: [hardwareCursor := cursorOrNil]].
	bounds := self cursorBounds.
	self
		userInitials: userInitials andPicture: self userPicture;
		layoutChanged;
		changed;
		showHardwareCursor: (temporaryCursor isNil).!

----- Method: HandMorph>>spawnBalloonFor: (in category 'balloon help') -----
spawnBalloonFor: aMorph
	aMorph showBalloon: aMorph balloonText hand: self.!

----- Method: HandMorph>>spawnMagicHaloFor: (in category 'halo handling') -----
spawnMagicHaloFor: aMorph
	(self halo notNil and:[self halo target == aMorph]) ifTrue:[^self].
	aMorph addMagicHaloFor: self.!

----- Method: HandMorph>>targetOffset (in category 'accessing') -----
targetOffset
	"Return the offset of the last mouseDown location relative to the origin of the recipient morph. During menu interactions, this is the absolute location of the mouse down event that invoked the menu."

	^ targetOffset
!

----- Method: HandMorph>>targetOffset: (in category 'grabbing/dropping') -----
targetOffset: offsetPoint
	"Set the offset at which we clicked down in the target morph"

	targetOffset := offsetPoint!

----- Method: HandMorph>>targetPoint (in category 'accessing') -----
targetPoint
	"Return the new position of the target.
	I.E. return the position of the hand less 
	the original distance between hand and target position"

	^ self position - targetOffset
!

----- Method: HandMorph>>temporaryCursor (in category 'cursor') -----
temporaryCursor
	^ temporaryCursor!

----- Method: HandMorph>>triggerBalloonFor:after: (in category 'balloon help') -----
triggerBalloonFor: aMorph after: timeOut
	"Trigger balloon help after the given time out for some morph"
	self addAlarm: #spawnBalloonFor: with: aMorph after: timeOut.!

----- Method: HandMorph>>triggerHaloFor:after: (in category 'halo handling') -----
triggerHaloFor: aMorph after: timeOut
	"Trigger automatic halo after the given time out for some morph"
	self addAlarm: #spawnMagicHaloFor: with: aMorph after: timeOut!

----- Method: HandMorph>>updateCacheCanvas: (in category 'drawing') -----
updateCacheCanvas: aCanvas 
	"Update the cached image of the morphs being held by this hand."

	"Note: The following is an attempt to quickly get out if there's no change"

	| subBnds rectList nPix |
	subBnds := Rectangle merging: (submorphs collect: [:m | m fullBounds]).
	rectList := damageRecorder invalidRectsFullBounds: subBnds.
	damageRecorder reset.
	(rectList isEmpty 
		and: [cacheCanvas notNil and: [cacheCanvas extent = subBnds extent]]) 
			ifTrue: [^self].

	"Always check for real translucency -- can't be cached in a form"
	self submorphsDo: 
			[:m | 
			m wantsToBeCachedByHand 
				ifFalse: 
					[cacheCanvas := nil.
					cachedCanvasHasHoles := true.
					^self]].
	(cacheCanvas isNil or: [cacheCanvas extent ~= subBnds extent]) 
		ifTrue: 
			[cacheCanvas := (aCanvas allocateForm: subBnds extent) getCanvas.
			cacheCanvas translateBy: subBnds origin negated
				during: [:tempCanvas | self drawSubmorphsOn: tempCanvas].
			self submorphsDo: 
					[:m | 
					(m areasRemainingToFill: subBnds) isEmpty 
						ifTrue: [^cachedCanvasHasHoles := false]].
			nPix := cacheCanvas form tallyPixelValues first.
			"--> begin rounded corners hack <---"
			cachedCanvasHasHoles := (nPix = 48 
						and: [submorphs size = 1 and: [submorphs first wantsRoundedCorners]]) 
							ifTrue: [false]
							ifFalse: [nPix > 0].
			"--> end rounded corners hack <---"
			^self].

	"incrementally update the cache canvas"
	cacheCanvas translateBy: subBnds origin negated
		during: 
			[:cc | 
			rectList do: 
					[:r | 
					cc clipBy: r
						during: 
							[:c | 
							c fillColor: Color transparent.
							self drawSubmorphsOn: c]]]!

----- Method: HandMorph>>userInitials (in category 'accessing') -----
userInitials

	^ userInitials!

----- Method: HandMorph>>userInitials:andPicture: (in category 'geometry') -----
userInitials: aString andPicture: aForm

	| cb pictRect initRect f |

	userInitials := aString.
	pictRect := initRect := cb := self cursorBounds.
	userInitials isEmpty ifFalse: [
		f := TextStyle defaultFont.
		initRect := cb topRight + (0 at 4) extent: (f widthOfString: userInitials)@(f height).
	].
	self userPicture: aForm.
	aForm ifNotNil: [
		pictRect := (self cursorBounds topRight + (0 at 24)) extent: aForm extent.
	].
	self bounds: ((cb merge: initRect) merge: pictRect).


!

----- Method: HandMorph>>userPicture (in category 'accessing') -----
userPicture
	^self valueOfProperty: #remoteUserPicture

!

----- Method: HandMorph>>userPicture: (in category 'accessing') -----
userPicture: aFormOrNil
	^self setProperty: #remoteUserPicture toValue: aFormOrNil
!

----- Method: HandMorph>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
	"Return self.  Do not copy hands this way."
	^ self!

----- Method: HandMorph>>visible: (in category 'drawing') -----
visible: aBoolean
	self needsToBeDrawn ifFalse: [ ^self ].
	super visible: aBoolean!

----- Method: HandMorph>>waitForClicksOrDrag:event: (in category 'double click support') -----
waitForClicksOrDrag: aMorph event: evt
	"Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
	This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
	The callback methods invoked on aMorph (which are passed a copy of evt) are:
		#click:	sent when the mouse button goes up within doubleClickTime.
		#doubleClick:	sent when the mouse goes up, down, and up again all within DoubleClickTime.
		#doubleClickTimeout:  sent when the mouse does not have a doubleClick within DoubleClickTime.
		#startDrag:	sent when the mouse moves more than 10 pixels from evt's position within DoubleClickTime.
	Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
	which is typically done by aMorph in its click:, doubleClick:, or drag: methods."
	
	^self waitForClicksOrDrag: aMorph event: evt selectors: #( #click: #doubleClick: #doubleClickTimeout: #startDrag:) threshold: 10
!

----- Method: HandMorph>>waitForClicksOrDrag:event:selectors:threshold: (in category 'double click support') -----
waitForClicksOrDrag: aMorph event: evt selectors: clickAndDragSelectors threshold: threshold

	"Wait for mouse button and movement events, informing aMorph about events interesting to it via callbacks.
	This message is typically sent to the Hand by aMorph when it first receives a mouse-down event.
	The callback methods, named in clickAndDragSelectors and passed a copy of evt, are:
		1 	(click) sent when the mouse button goes up within doubleClickTime.
		2	(doubleClick) sent when the mouse goes up, down, and up again all within DoubleClickTime.
		3	(doubleClickTimeout) sent when the mouse does not have a doubleClick within DoubleClickTime.
		4	(startDrag) sent when the mouse moves more than threshold pixels from evt's position within DoubleClickTime.
	Note that mouseMove: and mouseUp: events are not sent to aMorph until it becomes the mouse focus,
	which is typically done by aMorph 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.
!

----- Method: Morph class>>allSketchMorphClasses (in category 'testing') -----
allSketchMorphClasses
	"Morph allSketchMorphClasses"
	^ Array
		streamContents: [:s | self
				withAllSubclassesDo: [:cls | cls isSketchMorphClass
						ifTrue: [s nextPut: cls ]]]
!

----- Method: Morph class>>allSketchMorphForms (in category 'testing') -----
allSketchMorphForms
	"Answer a Set of forms of SketchMorph (sub) instances, except those 
	used as button images, ones being edited, and those with 0 extent."

	| reasonableForms |
	reasonableForms := Set new.
	Morph allSketchMorphClasses do:
		[:cls | cls allInstances do:
			[:m | | form |
			(m owner isKindOf: SketchEditorMorph orOf: IconicButton)
				ifFalse:
					[form := m form.
					((form width > 0) and: [form height > 0]) ifTrue: [reasonableForms add: form]]]].
	^ reasonableForms!

----- Method: Morph class>>authoringPrototype (in category 'scripting') -----
authoringPrototype
	"Answer an instance of the receiver suitable for placing in a parts bin for authors"
	
	^ self new markAsPartsDonor!

----- Method: Morph class>>fileReaderServicesForFile:suffix: (in category 'fileIn/Out') -----
fileReaderServicesForFile: fullName suffix: suffix

	^({ 'morph'. 'morphs'. 'sp'. '*' } includes: suffix)
		ifTrue: [
			{SimpleServiceEntry 
				provider: self 
				label: 'load as morph'
				selector: #fromFileName:
				description: 'load as morph'}]
		ifFalse: [#()]!

----- Method: Morph class>>fromFileName: (in category 'fileIn/Out') -----
fromFileName: fullName
	"Reconstitute a Morph from the file, presumed to be represent a Morph saved
	via the SmartRefStream mechanism, and open it in an appropriate Morphic world"

 	| aFileStream morphOrList |
	aFileStream := (MultiByteBinaryOrTextStream with: ((FileStream readOnlyFileNamed: fullName) binary contentsOfEntireFile)) binary reset.
	morphOrList := aFileStream fileInObjectAndCode.
	(morphOrList isKindOf: SqueakPage) ifTrue: [morphOrList := morphOrList contentsMorph].
	Smalltalk isMorphic
		ifTrue: [ActiveWorld addMorphsAndModel: morphOrList]
		ifFalse:
			[morphOrList isMorph ifFalse: [self inform: 'Can only load a single morph
into an mvc project via this mechanism.'].
			morphOrList openInWorld]!

----- Method: Morph class>>includeInNewMorphMenu (in category 'new-morph participation') -----
includeInNewMorphMenu
	"Return true for all classes that can be instantiated from the menu"
	^ true!

----- Method: Morph class>>initialize (in category 'class initialization') -----
initialize
	"Morph initialize"

	"this empty array object is shared by all morphs with no submorphs:"
	EmptyArray := Array new.
	FileList registerFileReader: self!

----- Method: Morph class>>initializedInstance (in category 'instance creation') -----
initializedInstance
	"Answer an instance of the receiver which in some sense is initialized.  In the case of Morphs, this will yield an instance that can be attached to the Hand after having received the same kind of basic initialization that would be obtained from an instance chosen from the 'new morph' menu.
	Return nil if the receiver is reluctant for some reason to return such a thing"

	^ (self class includesSelector: #descriptionForPartsBin)
		ifTrue:
			[self newStandAlone]
		ifFalse:
			[self new]!

----- Method: Morph class>>isSketchMorphClass (in category 'testing') -----
isSketchMorphClass
	^false!

----- Method: Morph class>>morphsUnknownToTheirOwners (in category 'misc') -----
morphsUnknownToTheirOwners
	"Return a list of all morphs (other than HandMorphs) whose owners do not contain them in their submorph lists"
	"Morph morphsUnknownToTheirOwners"
	| problemMorphs |
	problemMorphs := OrderedCollection new.
	self allSubInstances do:
		[:m | | itsOwner |
		(m isHandMorph not and: [((itsOwner := m owner) ~~ nil and: [(itsOwner submorphs includes: m) not])])
			ifTrue:
				[problemMorphs add: m]].
	^ problemMorphs!

----- Method: Morph class>>newBounds: (in category 'instance creation') -----
newBounds: bounds

	^ self new privateBounds: bounds!

----- Method: Morph class>>newBounds:color: (in category 'instance creation') -----
newBounds: bounds color: color

	^ (self new privateBounds: bounds) privateColor: color
!

----- Method: Morph class>>newStandAlone (in category 'new-morph participation') -----
newStandAlone
	"Answer an instance capable of standing by itself as a usable morph."

	^ self basicNew initializeToStandAlone!

----- Method: Morph class>>newSticky (in category 'instance creation') -----
newSticky

	^ self new beSticky!

----- Method: Morph class>>partName:categories:documentation: (in category 'new-morph participation') -----
partName: aName categories: aList documentation: aDoc
	"Answer a DescriptionForPartsBin which will represent a launch of a new instance of my class via the #newStandAlone protocol sent to my class. Use the category-list and documentation provided"


	^ DescriptionForPartsBin new
		formalName: aName
		categoryList: aList
		documentation: aDoc
		globalReceiverSymbol: self name
		nativitySelector: #newStandAlone!

----- Method: Morph class>>partName:categories:documentation:sampleImageForm: (in category 'new-morph participation') -----
partName: aName categories: aList documentation: aDoc sampleImageForm: aForm
	"Answer a DescriptionForPartsBin which will represent a launch of a new instance of my class via the #newStandAlone protocol sent to my class. Use the category-list and documentation provided.  This variant allows an overriding image form to be provided, useful in cases where we don't want to launch a sample instance just to get the form"

	| descr |
	descr := DescriptionForPartsBin new
		formalName: aName
		categoryList: aList
		documentation: aDoc
		globalReceiverSymbol: self name
		nativitySelector: #newStandAlone.
	descr sampleImageForm: aForm.
	^ descr
!

----- Method: Morph class>>serviceLoadMorphFromFile (in category 'fileIn/Out') -----
serviceLoadMorphFromFile
	"Answer a service for loading a .morph file"

	^ SimpleServiceEntry 
		provider: self 
		label: 'load as morph'
		selector: #fromFileName:
		description: 'load as morph'
		buttonLabel: 'load'!

----- Method: Morph class>>services (in category 'fileIn/Out') -----
services

	^ Array with: self serviceLoadMorphFromFile!

----- Method: Morph class>>unload (in category 'initialize-release') -----
unload

	FileList unregisterFileReader: self !

----- Method: Morph>>abandon (in category 'submorphs-add/remove') -----
abandon
	"Like delete, but we really intend not to use this morph again.  Clean up a few things."

	self delete!

----- Method: Morph>>aboutToBeGrabbedBy: (in category 'dropping/grabbing') -----
aboutToBeGrabbedBy: aHand
	"The receiver is being grabbed by a hand.
	Perform necessary adjustments (if any) and return the actual morph
	that should be added to the hand."
	| extentToHandToHand cmd |
	self formerOwner: owner.
	self formerPosition: self position.
	cmd := self undoGrabCommand.
	cmd ifNotNil:[self setProperty: #undoGrabCommand toValue: cmd].
	(extentToHandToHand := self valueOfProperty: #expandedExtent)
			ifNotNil:
				[self removeProperty: #expandedExtent.
				self extent: extentToHandToHand].
	^self "Grab me"!

----- Method: Morph>>absorbStateFromRenderer: (in category 'menus') -----
absorbStateFromRenderer: aRenderer 
	"Transfer knownName, actorState, visible, and player info over from aRenderer, which was formerly imposed above me as a transformation shell but is now going away."

	| current |
	(current := aRenderer actorStateOrNil) ifNotNil:
		[self actorState: current.
		aRenderer actorState: nil].

	(current := aRenderer knownName) ifNotNil:
		[self setNameTo: current.
		aRenderer setNameTo: nil].

	(current := aRenderer player) ifNotNil:
		[self player: current.
		current rawCostume: self.
		aRenderer player: nil].

	self visible: aRenderer visible!

----- Method: Morph>>acceptDroppingMorph:event: (in category 'layout') -----
acceptDroppingMorph: aMorph event: evt
	"This message is sent when a morph is dropped onto a morph that has agreed to accept the dropped morph by responding 'true' to the wantsDroppedMorph:Event: message. This default implementation just adds the given morph to the receiver."
	| layout |
	layout := self layoutPolicy.
	layout ifNil:[^self addMorph: aMorph].
	self privateAddMorph: aMorph 
		atIndex: (layout indexForInserting: aMorph at: evt position in: self).!

----- Method: Morph>>actWhen (in category 'submorphs-add/remove') -----
actWhen
	"Answer when the receiver, probably being used as a button, should have its action triggered"

	^ self valueOfProperty: #actWhen ifAbsentPut: [#buttonDown]!

----- Method: Morph>>actWhen: (in category 'submorphs-add/remove') -----
actWhen: aButtonPhase
	"Set the receiver's actWhen trait"

	self setProperty: #actWhen toValue: aButtonPhase!

----- Method: Morph>>actionMap (in category 'events-accessing') -----
actionMap
	"Answer an action map"

	| actionMap |
	actionMap := self valueOfProperty: #actionMap.
	actionMap ifNil:
		[actionMap := self createActionMap].
	^ actionMap!

----- Method: Morph>>activeHand (in category 'structure') -----
activeHand
	^ActiveHand!

----- Method: Morph>>actorState: (in category 'accessing') -----
actorState: anActorState 
	"change the receiver's actorState"
	self assureExtension actorState: anActorState!

----- Method: Morph>>actorStateOrNil (in category 'accessing') -----
actorStateOrNil
	"answer the redeiver's actorState"
	^ extension ifNotNil: [extension actorState]!

----- Method: Morph>>adaptToWorld: (in category 'e-toy support') -----
adaptToWorld: aWorld
	"The receiver finds itself operating in a possibly-different new world.  If any of the receiver's parts are world-dependent (such as a target of a SimpleButtonMorph, etc.), then have them adapt accordingly"
	submorphs do: [:m | m adaptToWorld: aWorld].
	self eventHandler ifNotNil:
		[self eventHandler adaptToWorld: aWorld]!

----- Method: Morph>>addAddHandMenuItemsForHalo:hand: (in category 'menus') -----
addAddHandMenuItemsForHalo: aMenu hand: aHandMorph
	"The former charter of this method was to add halo menu items that pertained specifically to the hand.  Over time this charter has withered, and most morphs reimplement this method simply to add their morph-specific menu items.  So in the latest round, all other implementors in the standard image have been removed.  However, this is left here as a hook for the benefit of existing code in client uses."

!

----- Method: Morph>>addAlarm:after: (in category 'events-alarms') -----
addAlarm: aSelector after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: #() after: delayTime!

----- Method: Morph>>addAlarm:at: (in category 'events-alarms') -----
addAlarm: aSelector at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: #() at: scheduledTime!

----- Method: Morph>>addAlarm:with:after: (in category 'events-alarms') -----
addAlarm: aSelector with: arg1 after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1) after: delayTime!

----- Method: Morph>>addAlarm:with:at: (in category 'events-alarms') -----
addAlarm: aSelector with: arg1 at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1) at: scheduledTime!

----- Method: Morph>>addAlarm:with:with:after: (in category 'events-alarms') -----
addAlarm: aSelector with: arg1 with: arg2 after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) after: delayTime!

----- Method: Morph>>addAlarm:with:with:at: (in category 'events-alarms') -----
addAlarm: aSelector with: arg1 with: arg2 at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: (Array with: arg1 with: arg2) at: scheduledTime!

----- Method: Morph>>addAlarm:withArguments:after: (in category 'events-alarms') -----
addAlarm: aSelector withArguments: args after: delayTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	^self addAlarm: aSelector withArguments: args at: Time millisecondClockValue + delayTime!

----- Method: Morph>>addAlarm:withArguments:at: (in category 'events-alarms') -----
addAlarm: aSelector withArguments: args at: scheduledTime
	"Add an alarm (that is an action to be executed once) with the given set of parameters"
	| scheduler |
	scheduler := self alarmScheduler.
	scheduler ifNotNil:[scheduler addAlarm: aSelector withArguments: args for: self at: scheduledTime].!

----- Method: Morph>>addAllMorphs: (in category 'submorphs-add/remove') -----
addAllMorphs: aCollection
	^self privateAddAllMorphs: aCollection atIndex: submorphs size!

----- Method: Morph>>addAllMorphs:after: (in category 'submorphs-add/remove') -----
addAllMorphs: aCollection after: anotherMorph
	^self privateAddAllMorphs: aCollection 
			atIndex: (submorphs indexOf: anotherMorph ifAbsent: [submorphs size])!

----- Method: Morph>>addBorderStyleMenuItems:hand: (in category 'menu') -----
addBorderStyleMenuItems: aMenu hand: aHandMorph
	"Probably one could offer border-style items even if it's not a borderedMorph, so this remains a loose end for the moment"
!

----- Method: Morph>>addCellLayoutMenuItems:hand: (in category 'layout-menu') -----
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!

----- Method: Morph>>addCopyItemsTo: (in category 'menus') -----
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.
	subMenu add: 'copy Postscript' translated action: #clipPostscript.
	subMenu add: 'print Postscript to file...' translated target: self selector: #printPSToFile.
	aMenu add: 'copy & print...' translated subMenu: subMenu!

----- Method: Morph>>addCustomHaloMenuItems:hand: (in category 'menus') -----
addCustomHaloMenuItems: aMenu hand: aHandMorph
	"Add morph-specific items to the given menu which was invoked by the given hand from the halo.  To get started, we defer to the counterpart method used with the option-menu, but in time we can have separate menu choices for halo-menus and for option-menus"

	self addCustomMenuItems: aMenu hand: aHandMorph!

----- Method: Morph>>addCustomMenuItems:hand: (in category 'menus') -----
addCustomMenuItems: aCustomMenu hand: aHandMorph
	"Add morph-specific items to the given menu which was invoked by the given hand.  This method provides is invoked both from the halo-menu and from the control-menu regimes."
!

----- Method: Morph>>addDebuggingItemsTo:hand: (in category 'debug and other') -----
addDebuggingItemsTo: aMenu hand: aHandMorph
	aMenu add: 'debug...' translated subMenu:  (self buildDebugMenu: aHandMorph)!

----- Method: Morph>>addDropShadow (in category 'drop shadows') -----
addDropShadow

	self hasDropShadow ifTrue:[^self].
	self changed.
	self hasDropShadow: true.
	self shadowOffset: 3 at 3.
	self layoutChanged.
	self changed.!

----- Method: Morph>>addDropShadowMenuItems:hand: (in category 'drop shadows') -----
addDropShadowMenuItems: aMenu hand: aHand
	| menu |
	menu := MenuMorph new defaultTarget: self.
	menu
		addUpdating: #hasDropShadowString
		action: #toggleDropShadow.
	menu addLine.
	menu add: 'shadow color...' translated target: self selector: #changeShadowColor.
	menu add: 'shadow offset...' translated target: self selector: #setShadowOffset:.
	aMenu add: 'drop shadow' translated subMenu: menu.!

----- Method: Morph>>addEmbeddingMenuItemsTo:hand: (in category 'meta-actions') -----
addEmbeddingMenuItemsTo: aMenu hand: aHandMorph
	"Construct a menu offerring embed targets for the receiver.  If the incoming menu is is not degenerate, add the constructed menu as a submenu; in any case, answer the embed-target menu"

	| menu potentialEmbeddingTargets |

	potentialEmbeddingTargets := self potentialEmbeddingTargets.
	potentialEmbeddingTargets size > 1 ifFalse:[^ self].

	menu := MenuMorph new defaultTarget: self.

	potentialEmbeddingTargets reverseDo: [:m | 
			menu
				add: (m knownName ifNil:[m class name asString])
				target: m
				selector: #addMorphFrontFromWorldPosition:
				argument: self topRendererOrSelf.

			menu lastItem icon: (m iconOrThumbnailOfSize: 16).

			self owner == m ifTrue:[menu lastItem emphasis: 1].
		].

	aMenu add:'embed into' translated subMenu: menu.

	^ menu!

----- Method: Morph>>addExportMenuItems:hand: (in category 'menus') -----
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]
!

----- Method: Morph>>addFillStyleMenuItems:hand: (in category 'menus') -----
addFillStyleMenuItems: aMenu hand: aHand
	"Add the items for changing the current fill style of the Morph"
	| menu |
	self canHaveFillStyles ifFalse:[^aMenu add: 'change color...' translated target: self action: #changeColor].
	menu := MenuMorph new defaultTarget: self.
	self fillStyle addFillStyleMenuItems: menu hand: aHand from: self.
	menu addLine.
	menu add: 'solid fill' translated action: #useSolidFill.
	menu add: 'gradient fill' translated action: #useGradientFill.
	menu add: 'bitmap fill' translated action: #useBitmapFill.
	menu add: 'default fill' translated action: #useDefaultFill.
	aMenu add: 'fill style' translated subMenu: menu.
	"aMenu add: 'change color...' translated action: #changeColor"!

----- Method: Morph>>addFlexShell (in category 'rotate scale and flex') -----
addFlexShell
	"Wrap a rotating and scaling shell around this morph."

	| oldHalo flexMorph myWorld anIndex |

	myWorld := self world.
	oldHalo := self halo.
	anIndex := self owner submorphIndexOf: self.
	self owner addMorph: (flexMorph := self newTransformationMorph asFlexOf: self)
		asElementNumber: anIndex.
	self transferStateToRenderer: flexMorph.
	oldHalo ifNotNil: [oldHalo setTarget: flexMorph].
	myWorld ifNotNil: [myWorld startSteppingSubmorphsOf: flexMorph].

	^ flexMorph!

----- Method: Morph>>addFlexShellIfNecessary (in category 'rotate scale and flex') -----
addFlexShellIfNecessary
	"If this morph requires a flex shell to scale or rotate,
		then wrap it in one and return it.
	Polygons, eg, may override to return themselves."

	^ self addFlexShell!

----- Method: Morph>>addGestureMenuItems:hand: (in category 'menu') -----
addGestureMenuItems: aMenu hand: aHandMorph
	"If the receiver wishes the Genie menu items, add a line to the menu and then those Genie items, else do nothing"!

----- Method: Morph>>addGraphModelYellowButtonItemsTo:event: (in category 'menu') -----
addGraphModelYellowButtonItemsTo: aCustomMenu event: evt
	^aCustomMenu!

----- Method: Morph>>addHalo (in category 'halos and balloon help') -----
addHalo
	"Invoke a halo programatically (e.g., not from a meta gesture)"
	^self addHalo: nil!

----- Method: Morph>>addHalo: (in category 'halos and balloon help') -----
addHalo: evt
	| halo prospectiveHaloClass |
	prospectiveHaloClass := Smalltalk at: self haloClass ifAbsent: [HaloMorph].
	halo := prospectiveHaloClass new bounds: self worldBoundsForHalo.
	halo popUpFor: self event: evt.
	^halo!

----- Method: Morph>>addHalo:from: (in category 'halos and balloon help') -----
addHalo: evt from: formerHaloOwner
	"Transfer a halo from the former halo owner to the receiver"
	^self addHalo: evt!

----- Method: Morph>>addHaloActionsTo: (in category 'menus') -----
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.
	"Note that this allows access to the non-instancing duplicate even when this is a uniclass instance"

	self couldMakeSibling ifTrue:
		[subMenu add: 'make a sibling' translated action: #handUserASibling.
		subMenu balloonTextForLastItem: 'Make a new sibling of this object and hand it to me' translated].

	subMenu addLine.
	subMenu add: 'property sheet' translated target: self renderedMorph action: #openAPropertySheet.
	subMenu balloonTextForLastItem: 'Open a property sheet for me. Allows changing lots of stuff at once.' translated.

	subMenu add: 'set color' translated target: self renderedMorph action: #changeColor.
	subMenu balloonTextForLastItem: 'Change the color of this object' translated.

	subMenu add: 'viewer' translated target: self action: #beViewed.
	subMenu balloonTextForLastItem: 'Open a Viewer that will allow everything about this object to be seen and controlled.' translated.

	subMenu balloonTextForLastItem: 'Open a tool that will facilitate tile scripting of this object.' translated.

	subMenu add: 'hand me a tile' translated target: self action: #tearOffTile.
	subMenu balloonTextForLastItem: 'Hand me a tile represting this object' translated.
	subMenu addLine.

	subMenu add: 'inspect' translated target: self action: #inspect.
	subMenu balloonTextForLastItem: 'Open an Inspector on this object' translated.

	aMenu add: 'halo actions...' translated subMenu: subMenu
!

----- Method: Morph>>addHandlesTo:box: (in category 'halos and balloon help') -----
addHandlesTo: aHaloMorph box: box
	"Add halo handles to the halo.  Apply the halo filter if appropriate"

	
	aHaloMorph haloBox: box.
	Preferences haloSpecifications  do:
		[:aSpec | | wantsIt aSelector | 
			aSelector :=  aSpec addHandleSelector.
			wantsIt := Preferences selectiveHalos
				ifTrue:
					[self wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph]
				ifFalse:
					[true].
			wantsIt ifTrue:
				[(#(addMakeSiblingHandle: addDupHandle:) includes: aSelector) ifTrue:
					[wantsIt := self preferredDuplicationHandleSelector = aSelector].
			wantsIt ifTrue:
				[aHaloMorph perform: aSelector with: aSpec]]].

	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box!

----- Method: Morph>>addLayoutMenuItems:hand: (in category 'layout-menu') -----
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!

----- Method: Morph>>addMagicHaloFor: (in category 'halos and balloon help') -----
addMagicHaloFor: aHand
	| halo prospectiveHaloClass |
	aHand halo ifNotNil:[
		aHand halo target == self ifTrue:[^self].
		aHand halo isMagicHalo ifFalse:[^self]].
	prospectiveHaloClass := Smalltalk at: self haloClass ifAbsent: [HaloMorph].
	halo := prospectiveHaloClass new bounds: self worldBoundsForHalo.
	halo popUpMagicallyFor: self hand: aHand.!

----- Method: Morph>>addMiscExtrasTo: (in category 'menus') -----
addMiscExtrasTo: aMenu
	"Add a submenu of miscellaneous extra items to the menu."

	| realOwner realMorph subMenu |
	subMenu := MenuMorph new defaultTarget: self.
	(self isWorldMorph not and: [(self renderedMorph isSystemWindow) not])
		ifTrue: [subMenu add: 'put in a window' translated action: #embedInWindow].

	self isWorldMorph ifFalse:
		[subMenu add: 'adhere to edge...' translated action: #adhereToEdge.
		subMenu addLine].

	realOwner := (realMorph := self topRendererOrSelf) owner.
	(realOwner isKindOf: TextPlusPasteUpMorph) ifTrue:
		[subMenu add: 'GeeMail stuff...' translated subMenu: (realOwner textPlusMenuFor: realMorph)].

	subMenu
		add: 'add mouse up action' translated action: #addMouseUpAction;
		add: 'remove mouse up action' translated action: #removeMouseUpAction;
		add: 'hand me tiles to fire this button' translated action: #handMeTilesToFire.
	subMenu addLine.
	subMenu add: 'arrowheads on pen trails...' translated action: #setArrowheads.
	subMenu addLine.

	subMenu defaultTarget: self topRendererOrSelf.
	subMenu add: 'draw new path' translated action: #definePath.
	subMenu add: 'follow existing path' translated action: #followPath.
	subMenu add: 'delete existing path' translated action: #deletePath.
	subMenu addLine.

	self addGestureMenuItems: subMenu hand: ActiveHand.

	aMenu add: 'extras...' translated subMenu: subMenu!

----- Method: Morph>>addModelYellowButtonItemsTo:event: (in category 'menu') -----
addModelYellowButtonItemsTo: aCustomMenu event: evt 
	"Give my models a chance to add their context-menu items to  
	aCustomMenu."
	self model
		ifNotNil: [:mod |
			mod
				addModelYellowButtonMenuItemsTo: aCustomMenu
				forMorph: self
				hand: evt hand]!

----- Method: Morph>>addMorph: (in category 'submorphs-add/remove') -----
addMorph: aMorph

	self addMorphFront: aMorph.!

----- Method: Morph>>addMorph:after: (in category 'submorphs-add/remove') -----
addMorph: newMorph after: aMorph
	"Add the given morph as one of my submorphs, inserting it after anotherMorph"
	^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph)+1!

----- Method: Morph>>addMorph:asElementNumber: (in category 'submorphs-add/remove') -----
addMorph: aMorph asElementNumber: aNumber
	"Add the given morph so that it becomes the aNumber'th element of my submorph list.  If aMorph is already one of my submorphs, reposition it"

	(submorphs includes: aMorph) ifTrue:
		[aMorph privateDelete].
	(aNumber <= submorphs size)
		ifTrue:
			[self addMorph: aMorph inFrontOf: (submorphs at: aNumber)]
		ifFalse:
			[self addMorphBack: aMorph]
!

----- Method: Morph>>addMorph:behind: (in category 'submorphs-add/remove') -----
addMorph: newMorph behind: aMorph
	"Add a morph to the list of submorphs behind the specified morph"
	^self privateAddMorph: newMorph atIndex: (submorphs indexOf: aMorph) + 1.
!

----- Method: Morph>>addMorph:fullFrame: (in category 'submorphs-add/remove') -----
addMorph: aMorph fullFrame: aLayoutFrame

	aMorph layoutFrame: aLayoutFrame.
	aMorph hResizing: #spaceFill; vResizing: #spaceFill.
	self addMorph: aMorph.

!

----- Method: Morph>>addMorph:inFrontOf: (in category 'submorphs-add/remove') -----
addMorph: newMorph inFrontOf: aMorph
	"Add a morph to the list of submorphs in front of the specified morph"
	^self privateAddMorph: newMorph atIndex: ((submorphs indexOf: aMorph) max: 1).!

----- Method: Morph>>addMorphBack: (in category 'submorphs-add/remove') -----
addMorphBack: aMorph
	^self privateAddMorph: aMorph atIndex: submorphs size+1!

----- Method: Morph>>addMorphCentered: (in category 'submorphs-add/remove') -----
addMorphCentered: aMorph

	aMorph position: bounds center - (aMorph extent // 2).
	self addMorphFront: aMorph.
!

----- Method: Morph>>addMorphFront: (in category 'submorphs-add/remove') -----
addMorphFront: aMorph
	^self privateAddMorph: aMorph atIndex: 1!

----- Method: Morph>>addMorphFront:fromWorldPosition: (in category 'submorphs-add/remove') -----
addMorphFront: aMorph fromWorldPosition: wp

	self addMorphFront: aMorph.
	aMorph position: (self transformFromWorld globalPointToLocal: wp)!

----- Method: Morph>>addMorphFrontFromWorldPosition: (in category 'submorphs-add/remove') -----
addMorphFrontFromWorldPosition: aMorph
	^self addMorphFront: aMorph fromWorldPosition: aMorph positionInWorld.!

----- Method: Morph>>addMorphInFrontOfLayer: (in category 'WiW support') -----
addMorphInFrontOfLayer: aMorph

	| targetLayer |

	targetLayer := aMorph morphicLayerNumberWithin: self.
	submorphs do: [ :each | | layerHere |
		each == aMorph ifTrue: [^self].
		layerHere := each morphicLayerNumberWithin: self.
		"the <= is the difference - it insures we go to the front of our layer"
		targetLayer <= layerHere ifTrue: [
			^self addMorph: aMorph inFrontOf: each
		].
	].
	self addMorphBack: aMorph.
!

----- Method: Morph>>addMorphInLayer: (in category 'WiW support') -----
addMorphInLayer: aMorph

	submorphs do: [ :each |
		each == aMorph ifTrue: [^self].
		aMorph morphicLayerNumber < each morphicLayerNumber ifTrue: [
			^self addMorph: aMorph inFrontOf: each
		].
	].
	self addMorphBack: aMorph
!

----- Method: Morph>>addMorphNearBack: (in category 'submorphs-add/remove') -----
addMorphNearBack: aMorph 
	| bg |
	(submorphs notEmpty and: [submorphs last mustBeBackmost]) 
		ifTrue: 
			[bg := submorphs last.
			bg privateDelete].
	self addMorphBack: aMorph.
	bg ifNotNil: [self addMorphBack: bg]!

----- Method: Morph>>addMouseActionIndicatorsWidth:color: (in category 'debug and other') -----
addMouseActionIndicatorsWidth: anInteger color: aColor

	self deleteAnyMouseActionIndicators.

	self changed.
	self hasRolloverBorder: true.
	self setProperty: #rolloverWidth toValue: anInteger at anInteger.
	self setProperty: #rolloverColor toValue: aColor.
	self layoutChanged.
	self changed.

!

----- Method: Morph>>addMouseUpAction (in category 'debug and other') -----
addMouseUpAction
	| codeToRun oldCode |
	oldCode := self
				valueOfProperty: #mouseUpCodeToRun
				ifAbsent: [''].
	codeToRun := UIManager default request: 'MouseUp expression:' translated initialAnswer: oldCode.
	self addMouseUpActionWith: codeToRun!

----- Method: Morph>>addMouseUpActionWith: (in category 'debug and other') -----
addMouseUpActionWith: codeToRun 
	((codeToRun isMessageSend) not and: [codeToRun isEmptyOrNil]) 
		ifTrue: [^self].
	self setProperty: #mouseUpCodeToRun toValue: codeToRun.
	self 
		on: #mouseUp
		send: #programmedMouseUp:for:
		to: self.
	self 
		on: #mouseDown
		send: #programmedMouseDown:for:
		to: self.
	self 
		on: #mouseEnter
		send: #programmedMouseEnter:for:
		to: self.
	self 
		on: #mouseLeave
		send: #programmedMouseLeave:for:
		to: self!

----- Method: Morph>>addMyYellowButtonMenuItemsToSubmorphMenus (in category 'menu') -----
addMyYellowButtonMenuItemsToSubmorphMenus
	"Answer true if I have items to add to the context menus of my submorphs"

	^true!

----- Method: Morph>>addNestedYellowButtonItemsTo:event: (in category 'menu') -----
addNestedYellowButtonItemsTo: aMenu event: evt 
	"Add items to aMenu starting with me and proceeding down 
	through my submorph chain, 
	letting any submorphs that include the event position 
	contribute their items to the bottom of the menu, separated by 
	a line."
	| underMouse |

	self addYellowButtonMenuItemsTo: aMenu event: evt.

	underMouse := self
				submorphThat: [:each | each containsPoint: evt position]
				ifNone: [^ self].

	(underMouse addMyYellowButtonMenuItemsToSubmorphMenus
			and: [underMouse hasYellowButtonMenu])
		ifTrue: [| submenu |
			aMenu addLine.
			submenu := MenuMorph new defaultTarget: underMouse.
			underMouse addNestedYellowButtonItemsTo: submenu event: evt.
			aMenu
				add: underMouse externalName
				icon: (underMouse iconOrThumbnailOfSize: 16)
				subMenu: submenu
		]
!

----- Method: Morph>>addOptionalHandlesTo:box: (in category 'halos and balloon help') -----
addOptionalHandlesTo: aHalo box: box
	aHalo addDirectionHandles!

----- Method: Morph>>addPaintingItemsTo:hand: (in category 'menus') -----
addPaintingItemsTo: aMenu hand: aHandMorph 
	| subMenu movies |
	subMenu := MenuMorph new defaultTarget: self.
	subMenu add: 'repaint' translated action: #editDrawing.
	subMenu add: 'set rotation center' translated action: #setRotationCenter.
	subMenu add: 'reset forward-direction' translated
		action: #resetForwardDirection.
	subMenu add: 'set rotation style' translated action: #setRotationStyle.
	subMenu add: 'erase pixels of color' translated
		action: #erasePixelsUsing:.
	subMenu add: 'recolor pixels of color' translated
		action: #recolorPixelsUsing:.
	subMenu add: 'reduce color palette' translated action: #reduceColorPalette:.
	subMenu add: 'add a border around this shape...' translated
		action: #addBorderToShape:.
	movies := (self world rootMorphsAt: aHandMorph targetPoint) 
				select: [:m | (m isKindOf: MovieMorph) or: [m isSketchMorph]].
	movies size > 1 
		ifTrue: 
			[subMenu add: 'insert into movie' translated action: #insertIntoMovie:].
	aMenu add: 'painting...' translated subMenu: subMenu!

----- Method: Morph>>addSimpleHandlesTo:box: (in category 'halos and balloon help') -----
addSimpleHandlesTo: aHaloMorph box: aBox
	^ aHaloMorph addSimpleHandlesTo: aHaloMorph box: aBox!

----- Method: Morph>>addStandardHaloMenuItemsTo:hand: (in category 'menus') -----
addStandardHaloMenuItemsTo: aMenu hand: aHandMorph
	"Add standard halo items to the menu"

	| unlockables |

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

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

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

	aMenu addLine.
	aMenu defaultTarget: self.

	aMenu addLine.

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

	aMenu defaultTarget: aHandMorph.
!

----- Method: Morph>>addTableLayoutMenuItems:hand: (in category 'layout-menu') -----
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!

----- Method: Morph>>addTextAnchorMenuItems:hand: (in category 'text-anchor') -----
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!

----- Method: Morph>>addTitleForHaloMenu: (in category 'menu') -----
addTitleForHaloMenu: aMenu 
	aMenu
		addTitle: self externalName
		icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifFalse:[28] ifTrue:[16]))!

----- Method: Morph>>addToggleItemsToHaloMenu: (in category 'menus') -----
addToggleItemsToHaloMenu: aMenu
	"Add standard true/false-checkbox items to the memu"

	#(
		(resistsRemovalString toggleResistsRemoval 'whether I should be reistant to easy deletion via the pink X handle' true)
		(stickinessString toggleStickiness 'whether I should be resistant to a drag done by mousing down on me' true)
		(lockedString lockUnlockMorph 'when "locked", I am inert to all user interactions' true)
		(hasClipSubmorphsString changeClipSubmorphs 'whether the parts of objects within me that are outside my bounds should be masked.' false)
		(hasDirectionHandlesString changeDirectionHandles 'whether direction handles are shown with the halo' false)
		(hasDragAndDropEnabledString changeDragAndDrop 'whether I am open to having objects dropped into me' false)
	)
		select:[:each | Preferences noviceMode not or:[each fourth]]
		thenDo:
		[:each |
			aMenu addUpdating: each first action: each second.
			aMenu balloonTextForLastItem: each third translated].

	self couldHaveRoundedCorners ifTrue:
		[aMenu addUpdating: #roundedCornersString action: #toggleCornerRounding.
		aMenu balloonTextForLastItem: 'whether my corners should be rounded' translated]!

----- Method: Morph>>addTransparentSpacerOfSize: (in category 'geometry eToy') -----
addTransparentSpacerOfSize: aPoint
	self addMorphBack: (self transparentSpacerOfSize: aPoint)!

----- Method: Morph>>addViewingItemsTo: (in category 'debug and other') -----
addViewingItemsTo: aMenu
	"Add viewing-related items to the given menu.  If any are added, this method is also responsible for adding a line after them"!

----- Method: Morph>>addWorldHandlesTo:box: (in category 'halos and balloon help') -----
addWorldHandlesTo: aHaloMorph box: box
	aHaloMorph haloBox: box.
	Preferences haloSpecificationsForWorld do:
		[:aSpec | 
			aHaloMorph perform: aSpec addHandleSelector with: aSpec].
	aHaloMorph innerTarget addOptionalHandlesTo: aHaloMorph box: box!

----- Method: Morph>>addWorldTargetSightingItems:hand: (in category 'menus') -----
addWorldTargetSightingItems: aCustomMenu hand: aHandMorph
"Use cursor to select a point on screen.
Set target from all possible morphs under cursor sight." 
	
	aCustomMenu addLine.
	
	aCustomMenu add: 'sight target' translated action: #sightWorldTargets:.
	!

----- Method: Morph>>addYellowButtonMenuItemsTo:event: (in category 'menu') -----
addYellowButtonMenuItemsTo: aMenu event: evt 
	"Populate aMenu with appropriate menu items for a  
	yellow-button (context menu) click."
	aMenu defaultTarget: self.
	""
	Preferences noviceMode
		ifFalse: [aMenu addStayUpItem].
	""
	self addModelYellowButtonItemsTo: aMenu event: evt.
	""
	Preferences generalizedYellowButtonMenu
		ifFalse: [^ self].
	""
	Preferences cmdGesturesEnabled
		ifTrue: [""
			aMenu addLine.
			aMenu add: 'inspect' translated action: #inspect].
	""
	aMenu addLine.
	self world selectedObject == self
		ifTrue: [aMenu add: 'deselect' translated action: #removeHalo]
		ifFalse: [aMenu add: 'select' translated action: #addHalo].
	""
	(self isWorldMorph
			or: [self mustBeBackmost
			or: [self wantsToBeTopmost]])
		ifFalse: [""
			aMenu addLine.
			aMenu add: 'send to back' translated action: #goBehind.
			aMenu add: 'bring to front' translated action: #comeToFront.
			self addEmbeddingMenuItemsTo: aMenu hand: evt hand].
	""
	self isWorldMorph
		ifFalse: [""
	Smalltalk
		at: #NCAAConnectorMorph
		ifPresent: [:connectorClass | 
			aMenu addLine.
			aMenu add: 'connect to' translated action: #startWiring.
			aMenu addLine].
	""

			self isFullOnScreen
				ifFalse: [aMenu add: 'move onscreen' translated action: #goHome]].
	""
	Preferences noviceMode
		ifFalse: [""
			self addLayoutMenuItems: aMenu hand: evt hand.
			(owner notNil
					and: [owner isTextMorph])
				ifTrue: [self addTextAnchorMenuItems: aMenu hand: evt hand]].
	""
	self isWorldMorph
		ifFalse: [""
			aMenu addLine.
			self addToggleItemsToHaloMenu: aMenu].
	""
	aMenu addLine.
	self isWorldMorph
		ifFalse: [aMenu add: 'copy to paste buffer' translated action: #copyToPasteBuffer:].
	(self allStringsAfter: nil) isEmpty
		ifFalse: [aMenu add: 'copy text' translated action: #clipText].
	""
	self addExportMenuItems: aMenu hand: evt hand.
	""
	(Preferences noviceMode not
			and: [self isWorldMorph not])
		ifTrue: [""
			aMenu addLine.
			aMenu add: 'adhere to edge...' translated action: #adhereToEdge].
	""
	self addCustomMenuItems: aMenu hand: evt hand!

----- Method: Morph>>addedMorph: (in category 'change reporting') -----
addedMorph: aMorph
	"Notify the receiver that the given morph was just added."
!

----- Method: Morph>>adhereToEdge (in category 'menus') -----
adhereToEdge
	| menu |
	menu := MenuMorph new defaultTarget: self.
	#(top right bottom left - center - topLeft topRight bottomRight bottomLeft - none)
		do: [:each |
			each == #-
				ifTrue: [menu addLine]
				ifFalse: [menu add: each asString translated selector: #setToAdhereToEdge: argument: each]].
	menu popUpEvent: self currentEvent in: self world!

----- Method: Morph>>adhereToEdge: (in category 'menus') -----
adhereToEdge: edgeSymbol 
	| edgeMessage |
	(owner isNil or: [owner isHandMorph]) ifTrue: [^self].
	(owner class canUnderstand:  edgeSymbol) ifFalse:  [^self].
	(self class canUnderstand: ( edgeMessage := (edgeSymbol , ':') asSymbol ))
		 ifFalse:  [^self].
	
	self perform: edgeMessage
		withArguments: (Array with: (owner perform: edgeSymbol))!

----- Method: Morph>>adjustLayoutBounds (in category 'layout') -----
adjustLayoutBounds
	"Adjust the receivers bounds depending on the resizing strategy imposed"
	| hFit vFit box myExtent extent |
	hFit := self hResizing.
	vFit := self vResizing.
	(hFit == #shrinkWrap or:[vFit == #shrinkWrap]) ifFalse:[^self]. "not needed"
	box := self layoutBounds.
	myExtent := box extent.
	extent := self submorphBounds corner - box origin.
	hFit == #shrinkWrap ifTrue:[myExtent := extent x @ myExtent y].
	vFit == #shrinkWrap ifTrue:[myExtent := myExtent x @ extent y].
	"Make sure we don't get smaller than minWidth/minHeight"
	myExtent x < self minWidth ifTrue:[
		myExtent := (myExtent x max: 
			(self minWidth - self bounds width + self layoutBounds width)) @ myExtent y].
	myExtent y < self minHeight ifTrue:[
		myExtent := myExtent x @ (myExtent y max:
			(self minHeight - self bounds height + self layoutBounds height))].
	self layoutBounds: (box origin extent: myExtent).!

----- Method: Morph>>adjustedCenter (in category 'menus') -----
adjustedCenter
	"Provides a hook for objects to provide a reference point other than the receiver's center,for the purpose of centering a submorph under special circumstances, such as BalloonMorph"

	^ self center!

----- Method: Morph>>adjustedCenter: (in category 'menus') -----
adjustedCenter: c
	"Set the receiver's position based on the #adjustedCenter protocol for adhereToEdge.  By default this simply sets the receiver's center.   Though there are (at its inception anyway) no other implementors of this method, it is required in use with the #adhereToEdge when the centering of a submorph is to be with reference to a rectangle  other than the receiver's center."

	self center: c!

----- Method: Morph>>adoptPaneColor: (in category 'accessing') -----
adoptPaneColor: paneColor
	self submorphsDo:[:m| m adoptPaneColor: paneColor].!

----- Method: Morph>>alarmScheduler (in category 'events-alarms') -----
alarmScheduler
	"Return the scheduler being responsible for triggering alarms"
	^self world!

----- Method: Morph>>align:with: (in category 'geometry') -----
align: aPoint1 with: aPoint2
	"Translate by aPoint2 - aPoint1."

	^ self position: self position + (aPoint2 - aPoint1)!

----- Method: Morph>>allKnownNames (in category 'submorphs-accessing') -----
allKnownNames
	"Return a list of all known names based on the scope of the receiver.  Does not include the name of the receiver itself.  Items in parts bins are excluded.  Reimplementors (q.v.) can extend the list"

	^ Array streamContents:
		[:s | self allSubmorphNamesDo: [:n | s nextPut: n]]
!

----- Method: Morph>>allMenuWordings (in category 'menus') -----
allMenuWordings
	| tempMenu |
	tempMenu := self buildHandleMenu: self currentHand.
	tempMenu allMorphsDo: [:m | m step].  "Get wordings current"
	^ tempMenu allWordings!

----- Method: Morph>>allMorphs (in category 'submorphs-accessing') -----
allMorphs
	"Return a collection containing all morphs in this composite morph (including the receiver)."

	| all |
	all := OrderedCollection new: 100.
	self allMorphsDo: [: m | all add: m].
	^ all!

----- Method: Morph>>allMorphsAndBookPagesInto: (in category 'e-toy support') -----
allMorphsAndBookPagesInto: aSet
	"Return a set of all submorphs.  Don't forget the hidden ones like BookMorph pages that are not showing.  Consider only objects that are in memory (see allNonSubmorphMorphs)." 

	submorphs do: [:m | m allMorphsAndBookPagesInto: aSet].
	self allNonSubmorphMorphs do: [:m | 
			(aSet includes: m) ifFalse: ["Stop infinite recursion"
				m allMorphsAndBookPagesInto: aSet]].
	aSet add: self.
	self player ifNotNil:
		[self player allScriptEditors do: [:e | e allMorphsAndBookPagesInto: aSet]].
	^ aSet!

----- Method: Morph>>allMorphsDo: (in category 'submorphs-accessing') -----
allMorphsDo: aBlock 
	"Evaluate the given block for all morphs in this composite morph (including the receiver)."

	submorphs do: [:m | m allMorphsDo: aBlock].
	aBlock value: self!

----- Method: Morph>>allMorphsWithPlayersDo: (in category 'submorphs-add/remove') -----
allMorphsWithPlayersDo: aTwoArgumentBlock 
	"Evaluate the given block for all morphs in this composite morph that have non-nil players.
	Also evaluate the block for the receiver if it has a player."

	submorphs do: [:m | m allMorphsWithPlayersDo: aTwoArgumentBlock ].
	self playerRepresented ifNotNil: [ :p | aTwoArgumentBlock value: self value: p ].
!

----- Method: Morph>>allNonSubmorphMorphs (in category 'submorphs-accessing') -----
allNonSubmorphMorphs
	"Return a collection containing all morphs in this morph which are not currently in the submorph containment hierarchy (put in primarily for bookmorphs)"

	^ OrderedCollection new!

----- Method: Morph>>allOwners (in category 'structure') -----
allOwners
	"Return the owners of the reciever"

	^ Array streamContents: [:strm | self allOwnersDo: [:m | strm nextPut: m]]!

----- Method: Morph>>allOwnersDo: (in category 'structure') -----
allOwnersDo: aBlock
	"Evaluate aBlock with all owners of the receiver"
	owner ifNotNil:[^owner withAllOwnersDo: aBlock].!

----- Method: Morph>>allStringsAfter: (in category 'debug and other') -----
allStringsAfter: aSubmorph 
	"return an OrderedCollection of strings of text in my submorphs.  If aSubmorph is non-nil, begin with that container."

	| list ok |
	list := OrderedCollection new.
	ok := aSubmorph isNil.
	self allMorphsDo: 
			[:sub | | string | 
			ok ifFalse: [ok := sub == aSubmorph].	"and do this one too"
			ok 
				ifTrue: 
					[(string := sub userString) ifNotNil: 
							[string isString ifTrue: [list add: string] ifFalse: [list addAll: string]]]].
	^list!

----- Method: Morph>>allSubmorphNamesDo: (in category 'submorphs-accessing') -----
allSubmorphNamesDo: nameBlock
	"Return a list of all known names of submorphs and nested submorphs of the receiver, based on the scope of the receiver.  Items in parts bins are excluded"

	self isPartsBin ifTrue: [^ self]. "Don't report names from parts bins"
	self submorphsDo: 
		[:m | m knownName ifNotNil: [:n | nameBlock value: n].
		m allSubmorphNamesDo: nameBlock].
!

----- Method: Morph>>allowsGestureStart: (in category 'geniestubs') -----
allowsGestureStart: evt
	^false!

----- Method: Morph>>altSpecialCursor0 (in category 'debug and other') -----
altSpecialCursor0
	"an arrow"
	^(Form
	extent: 16 at 16
	depth: 8
	fromArray: #( 0 0 0 0 14869218 3806520034 3806520034 3791650816 14848144 2425393296 2425393378 0 14848144 2425393296 2425414144 0 14848144 2425393296 2430730240 0 14848144 2425393296 3791650816 0 14848144 2425393378 3791650816 0 14848144 2425414370 3806461952 0 14848144 2430788322 3806519808 0 14848144 3791651042 3806520034 0 14848226 0 3806520034 3791650816 14868992 0 14869218 3806461952 14811136 0 58082 3806519808 0 0 226 3806520034 0 0 0 3806520034 0 0 0 14869218)
	offset: 0 at 0)
!

----- Method: Morph>>altSpecialCursor1 (in category 'debug and other') -----
altSpecialCursor1
	"a star and an arrow"
	^(Form
	extent: 31 at 26
	depth: 8
	fromArray: #( 14417920 0 0 0 0 0 0 0 3705461980 3705461980 3705405440 0 0 0 0 0 3705461980 3705461980 3705461760 0 0 0 0 0 14474460 3705461980 3705405440 0 0 0 0 0 56540 3705461980 3690987520 0 0 3690987520 0 0 220 3705461980 3705461760 0 0 3690987520 0 0 220 3705405440 3705461980 0 0 3705405440 0 0 0 3705461760 56540 3690987520 220 3705405440 0 0 0 3705405440 220 3705461760 220 3705405440 0 0 0 0 0 14474460 220 3705461760 0 0 0 0 0 56540 3691044060 3705461760 0 0 0 0 0 220 3705461980 3705461760 0 0 0 0 56540 3705461980 3705461980 3705461980 3705461980 3705461760 0 0 220 3705461980 3705461980 3705461980 3705461980 3705461760 0 0 0 3705461980 3705461980 3705461980 3705461980 3705405440 0 0 0 14474460 3705461980 3705461980 3705461980 3690987520 0 0 0 56540 3705461980 3705461980 3705461760 0 0 0 0 220 3705461980 3705461980 3705405440 0 0 0 0 0 3705461980 3705461980 3690987520 0 0 0 0 0 3705461980 3705461980 3705405440 0 0 0 0 220 3705461980 3705461980 3705405440 0 0 0 0 220 3705461980 3705461980 3705405440 0 0 0 0 220 3705461980 14474460 3705405440 0 0 0 0 220 3705405440 220 3705461760 0 0 0 0 56540 3690987520 0 3705461760 0 0 0 0 56540 0 0 14474240 0)
	offset: 0 at 0)!

----- Method: Morph>>altSpecialCursor2 (in category 'debug and other') -----
altSpecialCursor2
	| f |
	"a blue box with transparent center"
	f := Form extent: 32 at 32 depth: 32.
	f offset: (f extent // 2) negated.
	f fill: f boundingBox rule: Form over fillColor: (Color blue alpha: 0.5).
	f fill: (f boundingBox insetBy: 4) rule: Form over fillColor: Color transparent.
	^f
!

----- Method: Morph>>altSpecialCursor3 (in category 'debug and other') -----
altSpecialCursor3
	
	^self altSpecialCursor3: Color blue!

----- Method: Morph>>altSpecialCursor3: (in category 'debug and other') -----
altSpecialCursor3: aColor
	| f box |
	"a bulls-eye pattern in this color"
	f := Form extent: 32 at 32 depth: 32.
	f offset: (f extent // 2) negated.
	box := f boundingBox.
	[ box width > 0] whileTrue: [
		f fill: box rule: Form over fillColor: aColor.
		f fill: (box insetBy: 2) rule: Form over fillColor: Color transparent.
		box := box insetBy: 4.
	].
	^f
!

----- Method: Morph>>applyStatusToAllSiblings: (in category 'meta-actions') -----
applyStatusToAllSiblings: evt
	"Apply the statuses of all my scripts to the script status of all my siblings"

	| aPlayer |
	(aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
	aPlayer instantiatedUserScriptsDo: 
		[:aScriptInstantiation | aScriptInstantiation assignStatusToAllSiblings]!

----- Method: Morph>>areasRemainingToFill: (in category 'drawing') -----
areasRemainingToFill: aRectangle
	"May be overridden by any subclasses with opaque regions"

	^ Array with: aRectangle!

----- Method: Morph>>arrangeToStartStepping (in category 'stepping and presenter') -----
arrangeToStartStepping
	"Arrange to start getting sent the 'step' message, but don't do that initial #step call that startStepping does"

	self arrangeToStartSteppingIn: self world!

----- Method: Morph>>arrangeToStartSteppingIn: (in category 'stepping and presenter') -----
arrangeToStartSteppingIn: aWorld
	"Start getting sent the 'step' message in aWorld.  Like startSteppingIn:, but without the initial one to get started'"
	aWorld ifNotNil:
		[aWorld startStepping: self.
		self changed]!

----- Method: Morph>>asDraggableMorph (in category 'converting') -----
asDraggableMorph
	^self!

----- Method: Morph>>asMorph (in category 'creation') -----
asMorph
	^ self!

----- Method: Morph>>asNumber: (in category 'e-toy support') -----
asNumber: aPointOrNumber
	"Support for e-toy demo."

	aPointOrNumber class = Point
		ifTrue: [^ aPointOrNumber r]
		ifFalse: [^ aPointOrNumber].
!

----- Method: Morph>>asSnapshotThumbnail (in category 'converting') -----
asSnapshotThumbnail
	^(ThumbnailImageMorph new  newImage: self imageForm ) extent: 90 asPoint .!

----- Method: Morph>>assureExtension (in category 'accessing - extension') -----
assureExtension
	"creates an extension for the receiver if needed"
	extension ifNil: [self initializeExtension].
	^ extension!

----- Method: Morph>>assureExternalName (in category 'player') -----
assureExternalName
	| aName |
	^ (aName := self knownName) ifNil:
		[self setNameTo: (aName := self externalName).
		^ aName]!

----- Method: Morph>>assureLayoutProperties (in category 'layout-properties') -----
assureLayoutProperties
	| props |
	props := self layoutProperties.
	props == self ifTrue:[props := nil].
	props ifNil:[
		props := LayoutProperties new initializeFrom: self.
		self layoutProperties: props].
	^props!

----- Method: Morph>>assureTableProperties (in category 'layout-properties') -----
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!

----- Method: Morph>>attachToResource (in category 'fileIn/out') -----
attachToResource
	"Produce a morph from a file -- either a saved .morph file or a graphics file"

	| pathName |
	pathName := Utilities chooseFileWithSuffixFromList: (#('.morph'), Utilities graphicsFileSuffixes)
			withCaption: 'Choose a file
to load'.
	pathName ifNil: [^ self].  "User made no choice"
	pathName == #none ifTrue: [^ self inform: 
'Sorry, no suitable files found
(names should end with .morph, .gif,
.bmp, .jpeg, .jpe, .jp, or .form)'].

	self setProperty: #resourceFilePath toValue: pathName!

----- Method: Morph>>automaticViewing (in category 'e-toy support') -----
automaticViewing
	"Backstop, in case this message gets sent to an owner that is not a playfield"
	^ false!

----- Method: Morph>>balloonColor (in category 'halos and balloon help') -----
balloonColor
	^ self
		valueOfProperty: #balloonColor
		ifAbsent: [self defaultBalloonColor]!

----- Method: Morph>>balloonColor: (in category 'halos and balloon help') -----
balloonColor: aColor
	^ self
		setProperty: #balloonColor
		toValue: aColor!

----- Method: Morph>>balloonFont (in category 'halos and balloon help') -----
balloonFont
	^ self
		valueOfProperty: #balloonFont
		ifAbsent: [self defaultBalloonFont]!

----- Method: Morph>>balloonFont: (in category 'halos and balloon help') -----
balloonFont: aFont 
	^ self setProperty: #balloonFont toValue: aFont!

----- Method: Morph>>balloonHelpAligner (in category 'halos and balloon help') -----
balloonHelpAligner
	"Answer the morph to which the receiver's balloon help should point"
	^ (self valueOfProperty: #balloonTarget) ifNil: [self]!

----- Method: Morph>>balloonHelpDelayTime (in category 'halos and balloon help') -----
balloonHelpDelayTime
	"Return the number of milliseconds before a balloon help should be put up on the receiver. The balloon help will only be put up if the receiver responds to #wantsBalloon by returning true."
	^ Preferences balloonHelpDelayTime!

----- Method: Morph>>balloonHelpTextForHandle: (in category 'halos and balloon help') -----
balloonHelpTextForHandle: aHandle 
	"Answer a string providing balloon help for the
	given halo handle"
	| itsSelector |
	itsSelector := aHandle eventHandler firstMouseSelector.
	itsSelector == #doRecolor:with:
		ifTrue: [^ Preferences propertySheetFromHalo
				ifTrue: ['Open a property sheet.']
				ifFalse: ['Change color']].
	itsSelector == #mouseDownInDimissHandle:with:
		ifTrue: [^ Preferences preserveTrash
				ifTrue: ['Move to trash']
				ifFalse: ['Remove from screen']].
	#(#(#addFullHandles 'More halo handles') #(#addSimpleHandles 'Fewer halo handles') #(#chooseEmphasisOrAlignment 'Emphasis & alignment') #(#chooseFont 'Change font') #(#chooseNewGraphicFromHalo 'Choose a new graphic') #(#chooseStyle 'Change style') #(#dismiss 'Remove') #(#doDebug:with: 'Debug') #(#doDirection:with: 'Choose forward direction') #(#doDup:with: 'Duplicate') #(#doMakeSibling:with: 'Make a sibling') #(#doMenu:with: 'Menu') #(#doGrab:with: 'Pick up') #(#editButtonsScript 'See the script for this button') #(#editDrawing 'Repaint') #(#doDupOrMakeSibling:with: 'Duplicate (press shift to make a sibling)') #(#doMakeSiblingOrDup:with: 'Make a sibling (press shift to make simple duplicate)') #(#makeNascentScript 'Make a scratch script') #(#makeNewDrawingWithin 'Paint new object') #(#mouseDownInCollapseHandle:with: 'Collapse') #(#mouseDownOnHelpHandle: 'Help') #(#openViewerForArgument 'Open a Viewer for me. Press shift for a snapshot.') #(#openViewerForTarget:with: 'Open a Viewer for me. Press shift for a snapshot.') #(#paintBackground 'Paint background') #(#prepareToTrackCenterOfRotation:with: 'Move object or set center of rotation') #(#presentViewMenu 'Present the Viewing menu') #(#startDrag:with: 'Move') #(#startGrow:with: 'Change size') #(#startRot:with: 'Rotate') #(#startScale:with: 'Change scale') #(#tearOffTile 'Make a tile representing this object') #(#tearOffTileForTarget:with: 'Make a tile representing this object') #(#trackCenterOfRotation:with: 'Set center of rotation') )
		do: [:pair | itsSelector == pair first
				ifTrue: [^ pair last]].
	^ 'unknown halo handle'translated!

----- Method: Morph>>balloonText (in category 'accessing') -----
balloonText
	"Answer balloon help text or nil, if no help is available.  
	NB: subclasses may override such that they programatically  
	construct the text, for economy's sake, such as model phrases in 
	a Viewer"

	| text balloonSelector aString |
	extension ifNil: [^nil].
	(text := extension balloonText) ifNotNil: [^text].
	(balloonSelector := extension balloonTextSelector) ifNotNil: 
			[aString := ScriptingSystem helpStringOrNilFor: balloonSelector.
			(aString isNil and: [balloonSelector == #methodComment]) 
				ifTrue: [aString := self methodCommentAsBalloonHelp].
			((aString isNil and: [balloonSelector numArgs = 0]) 
				and: [self respondsTo: balloonSelector]) 
					ifTrue: [aString := self perform: balloonSelector]].
	^aString ifNotNil: 
			[aString asString 
				withNoLineLongerThan: Preferences maxBalloonHelpLineLength]!

----- Method: Morph>>balloonTextSelector (in category 'accessing') -----
balloonTextSelector
	"Answer balloon text selector item in the extension, nil if none"
	^ extension ifNotNil: [extension balloonTextSelector]!

----- Method: Morph>>balloonTextSelector: (in category 'accessing') -----
balloonTextSelector: aSelector 
	"change the receiver's balloonTextSelector"
	self assureExtension balloonTextSelector: aSelector!

----- Method: Morph>>basicInitialize (in category 'initialization') -----
basicInitialize
	"Do basic generic initialization of the instance variables:  
	Set up the receiver, created by a #basicNew and now ready to  
	be initialized, by placing initial values in the instance variables  
	as appropriate"
owner := nil.
	submorphs := EmptyArray.
	bounds := self defaultBounds.
	
	color := self defaultColor!

----- Method: Morph>>beFlap: (in category 'accessing') -----
beFlap: aBool
	"Mark the receiver with the #flap property, or unmark it"

	aBool
		ifTrue:
			[self setProperty: #flap toValue: true.
			self hResizing: #rigid.
			self vResizing: #rigid]
		ifFalse:
			[self removeProperty: #flap]!

----- Method: Morph>>beSticky (in category 'accessing') -----
beSticky
	"make the receiver sticky"
	self assureExtension sticky: true!

----- Method: Morph>>beThisWorldsModel (in category 'meta-actions') -----
beThisWorldsModel

	self world setModel: self.
	self model: nil slotName: nil.	"A world's model cannot have another model"!

----- Method: Morph>>beTransparent (in category 'geometry eToy') -----
beTransparent
	self color: Color transparent!

----- Method: Morph>>beUnsticky (in category 'accessing') -----
beUnsticky
	"If the receiver is marked as sticky, make it now be unsticky"
	extension ifNotNil: [extension sticky: false]!

----- Method: Morph>>becomeModal (in category 'user interface') -----
becomeModal
	self currentWorld
		ifNotNil: [self currentWorld modalWindow: self]!

----- Method: Morph>>blueButtonDown: (in category 'meta-actions') -----
blueButtonDown: anEvent
	"Special gestures (cmd-mouse on the Macintosh; Alt-mouse on Windows and Unix) allow a mouse-sensitive morph to be moved or bring up a halo for the morph."
	| h tfm doNotDrag |
	h := anEvent hand halo.
	"Prevent wrap around halo transfers originating from throwing the event back in"
	doNotDrag := false.
	h ifNotNil:[
		(h innerTarget == self) ifTrue:[doNotDrag := true].
		(h innerTarget hasOwner: self) ifTrue:[doNotDrag := true].
		(self hasOwner: h target) ifTrue:[doNotDrag := true]].

	tfm := (self transformedFrom: nil) inverseTransformation.

	"cmd-drag on flexed morphs works better this way"
	h := self addHalo: (anEvent transformedBy: tfm).
	h ifNil: [^ self].
	doNotDrag ifTrue:[^self].
	"Initiate drag transition if requested"
	anEvent hand 
		waitForClicksOrDrag: h
		event: (anEvent transformedBy: tfm)
		selectors: { nil. nil. nil. #dragTarget:. }
		threshold: 5.
	"Pass focus explicitly here"
	anEvent hand newMouseFocus: h.!

----- Method: Morph>>blueButtonUp: (in category 'meta-actions') -----
blueButtonUp: anEvent
	"Ignored. Theoretically we should never get here since control is transferred to the halo on #blueButtonDown: but subclasses may implement this differently."!

----- Method: Morph>>borderColor (in category 'accessing') -----
borderColor
	^self borderStyle color!

----- Method: Morph>>borderColor: (in category 'accessing') -----
borderColor: aColorOrSymbolOrNil 
	"Unfortunately, the argument to borderColor could be more than 	just a color. 
	It could also be a symbol, in which case it is to be interpreted as a style identifier.
	But I might not be able to draw that kind of border, so it may have to be ignored.
	Or it could be nil, in which case I should revert to the default border."

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

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

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

----- Method: Morph>>borderStyle (in category 'accessing') -----
borderStyle
	^(self valueOfProperty: #borderStyle ifAbsent:[BorderStyle default]) trackColorFrom: self!

----- Method: Morph>>borderStyle: (in category 'accessing') -----
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].!

----- Method: Morph>>borderStyleForSymbol: (in category 'accessing') -----
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]!

----- Method: Morph>>borderWidth (in category 'accessing') -----
borderWidth
	^self borderStyle width!

----- Method: Morph>>borderWidth: (in category 'accessing') -----
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 ].
!

----- Method: Morph>>borderWidthForRounding (in category 'accessing') -----
borderWidthForRounding

	^ self borderWidth!

----- Method: Morph>>bottom (in category 'geometry') -----
bottom
	" Return the y-coordinate of my bottom side "

	^ bounds bottom!

----- Method: Morph>>bottom: (in category 'geometry') -----
bottom: aNumber
	" Move me so that my bottom is at the y-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (bounds left @ (aNumber - self height))!

----- Method: Morph>>bottomCenter (in category 'geometry') -----
bottomCenter

	^ bounds bottomCenter!

----- Method: Morph>>bottomLeft (in category 'geometry') -----
bottomLeft

	^ bounds bottomLeft!

----- Method: Morph>>bottomLeft: (in category 'geometry') -----
bottomLeft: aPoint
	" Move me so that my bottom left corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x) @ (aPoint y - self height)).
!

----- Method: Morph>>bottomRight (in category 'geometry') -----
bottomRight

	^ bounds bottomRight!

----- Method: Morph>>bottomRight: (in category 'geometry') -----
bottomRight: aPoint
	" Move me so that my bottom right corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x - bounds width) @ (aPoint y - self height))
!

----- Method: Morph>>boundingBoxOfSubmorphs (in category 'drawing') -----
boundingBoxOfSubmorphs
	| aBox |
	aBox := bounds origin extent: self minimumExtent.  "so won't end up with something empty"
	submorphs do:
		[:m | m visible ifTrue: [aBox := aBox quickMerge: m fullBounds]].
	^ aBox
!

----- Method: Morph>>bounds (in category 'geometry') -----
bounds
	"Return the bounds of this morph."
	"Note: It is best not to override this method because many methods in Morph and its subclasses use the instance variable directly rather than 'self bounds'. Instead, subclasses should be sure that the bounds instance variable is correct."

	^ bounds
!

----- Method: Morph>>bounds: (in category 'geometry') -----
bounds: newBounds
	| oldExtent newExtent |
	oldExtent := self extent.
	newExtent := newBounds extent.
	(oldExtent dotProduct: oldExtent) <= (newExtent dotProduct: newExtent) ifTrue:[
		"We're growing. First move then resize."
		self position: newBounds topLeft; extent: newExtent.
	] ifFalse:[
		"We're shrinking. First resize then move."
		self extent: newExtent; position: newBounds topLeft.
	].!

----- Method: Morph>>bounds:from: (in category 'geometry') -----
bounds: aRectangle from: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	owner ifNil: [^ aRectangle].
	^(owner transformFrom: referenceMorph) globalBoundsToLocal: aRectangle
!

----- Method: Morph>>bounds:in: (in category 'geometry') -----
bounds: aRectangle in: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	owner ifNil: [^ aRectangle].
	^(owner transformFrom: referenceMorph) localBoundsToGlobal: aRectangle
!

----- Method: Morph>>boundsForBalloon (in category 'halos and balloon help') -----
boundsForBalloon

	"some morphs have bounds that are way too big"
	^self boundsInWorld!

----- Method: Morph>>boundsIn: (in category 'geometry') -----
boundsIn: referenceMorph
	"Return the receiver's bounds as seen by aMorphs coordinate frame"
	^self bounds: self bounds in: referenceMorph!

----- Method: Morph>>boundsInWorld (in category 'geometry') -----
boundsInWorld
	^self bounds: self bounds in: self world!

----- Method: Morph>>boundsWithinCorners (in category 'drawing') -----
boundsWithinCorners

	^ CornerRounder rectWithinCornersOf: self bounds!

----- Method: Morph>>bringAllSiblingsToMe: (in category 'meta-actions') -----
bringAllSiblingsToMe: evt
	"bring all siblings of the receiver's player found in the same container to the receiver's location."

	| aPlayer aPosition aContainer |
	(aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
	aPosition := self topRendererOrSelf position.
	aContainer := self topRendererOrSelf owner.
	(aPlayer class allInstances copyWithout: aPlayer) do:
		[:each |
			(aContainer submorphs includes: each costume) ifTrue:
				[each costume  position: aPosition]]!

----- Method: Morph>>buildDebugMenu: (in category 'debug and other') -----
buildDebugMenu: aHand
	"Answer a debugging menu for the receiver.  The hand argument is seemingly historical and plays no role presently"

	| aMenu aPlayer |
	aMenu := MenuMorph new defaultTarget: self.
	aMenu addStayUpItem.
	(self hasProperty: #errorOnDraw) 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.
	Smalltalk isMorphic ifFalse:
		[aMenu add: 'inspect morph (in MVC)' translated action: #inspect].

	self isMorphicModel ifTrue:
		[aMenu add: 'inspect model' translated target: self model action: #inspect].
	(aPlayer := self player) ifNotNil:
		[aMenu add: 'inspect player' translated target: aPlayer action: #inspect].

     aMenu add: 'explore morph' translated target: self selector: #explore.

	aMenu addLine.
	aPlayer ifNotNil:
		[ aMenu add: 'viewer for Player' translated target: self player action: #beViewed.
	aMenu balloonTextForLastItem: 'Opens a viewer on my Player -- this is the same thing you get if you click on the cyan "View" halo handle' translated ].

	aMenu add: 'viewer for Morph' translated target: self action: #viewMorphDirectly.
	aMenu balloonTextForLastItem: 'Opens a Viewer on this Morph, rather than on its Player' translated.
	aMenu addLine.

	aPlayer ifNotNil:
		[aPlayer class isUniClass ifTrue: [
			aMenu add: 'browse player class' translated target: aPlayer action: #browseHierarchy]].
	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.

	self addViewingItemsTo: aMenu.
	aMenu 
		add: 'make own subclass' translated action: #subclassMorph;
		add: 'save morph in file' translated  action: #saveOnFile;
		addLine;
		add: 'call #tempCommand' translated action: #tempCommand;
		add: 'define #tempCommand' translated action: #defineTempCommand;
		addLine;

		add: 'control-menu...' translated target: self selector: #invokeMetaMenu:;
		add: 'edit balloon help' translated action: #editBalloonHelpText.

	^ aMenu!

----- Method: Morph>>buildHandleMenu: (in category 'meta-actions') -----
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 |

	(Preferences generalizedYellowButtonMenu
			and: [Preferences noviceMode])
		ifTrue: [^ self buildYellowButtonMenu: aHand].

	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
!

----- Method: Morph>>buildMetaMenu: (in category 'meta-actions') -----
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 add: 'copy Postscript' translated action: #clipPostscript.
	menu add: 'print Postscript to file...' translated action: #printPSToFile.
	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 addDropShadowMenuItems: 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: 'make own subclass' translated action: #subclassMorph.
	menu addLine.
	(self isMorphicModel) ifTrue:
		[menu add: 'save morph as prototype' translated action: #saveAsPrototype.
		(self ~~ self world modelOrNil) ifTrue:
			 [menu add: 'become this world''s model' translated action: #beThisWorldsModel]].
	menu add: 'save morph in file' translated action: #saveOnFile.
	(self hasProperty: #resourceFilePath)
		ifTrue: [((self valueOfProperty: #resourceFilePath) endsWith: '.morph')
				ifTrue: [menu add: 'save as resource' translated action: #saveAsResource].
				menu add: 'update from resource' translated action: #updateFromResource]
		ifFalse: [menu add: 'attach to resource' translated action: #attachToResource].
	menu add: 'show actions' translated action: #showActions.
	menu addLine.
	self addDebuggingItemsTo: menu hand: evt hand.

	self addCustomMenuItems: menu hand: evt hand.
	^ menu
!

----- Method: Morph>>buildYellowButtonMenu: (in category 'menu') -----
buildYellowButtonMenu: aHand 
	"build the morph menu for the yellow button"
	| menu |
	menu := MenuMorph new defaultTarget: self.
	self addNestedYellowButtonItemsTo: menu event: ActiveEvent.
	MenuIcons decorateMenu: menu.
	^ menu!

----- Method: Morph>>canDrawAtHigherResolution (in category 'testing') -----
canDrawAtHigherResolution

	^false!

----- Method: Morph>>canDrawBorder: (in category 'testing') -----
canDrawBorder: aBorderStyle
	"Return true if the receiver can be drawn with the given border style."
	^true!

----- Method: Morph>>canHaveFillStyles (in category 'visual properties') -----
canHaveFillStyles
	"Return true if the receiver can have general fill styles; not just colors.
	This method is for gradually converting old morphs."
	^self class == Morph "no subclasses"!

----- Method: Morph>>cartesianBoundsTopLeft (in category 'geometry eToy') -----
cartesianBoundsTopLeft
	"Answer the origin of this morph relative to it's container's cartesian origin. 
	NOTE: y DECREASES toward the bottom of the screen"

	| w container |

	w := self world ifNil: [^ bounds origin].
	container := self referencePlayfield ifNil: [w].
	^ (bounds left - container cartesianOrigin x) @
		(container cartesianOrigin y - bounds top)!

----- Method: Morph>>cartesianXY: (in category 'geometry eToy') -----
cartesianXY: coords
	^ self x: coords x y: coords y
!

----- Method: Morph>>cellInset (in category 'layout-properties') -----
cellInset
	"Layout specific. This property specifies an extra inset for each cell in the layout."
	| props |
	props := self layoutProperties.
	^props ifNil:[0] ifNotNil:[props cellInset].!

----- Method: Morph>>cellInset: (in category 'layout-properties') -----
cellInset: aNumber
	"Layout specific. This property specifies an extra inset for each cell in the layout."
	self assureTableProperties cellInset: aNumber.
	self layoutChanged.!

----- Method: Morph>>cellPositioning (in category 'layout-properties') -----
cellPositioning
	"Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
		#topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center 
	which align the receiver's bounds with the cell at the given point."
	| props |
	props := self layoutProperties.
	^props ifNil:[#center] ifNotNil:[props cellPositioning].!

----- Method: Morph>>cellPositioning: (in category 'layout-properties') -----
cellPositioning: aSymbol
	"Layout specific. This property describes how the receiver should be layed out in its owner when the bounds of the cell assigned to the receiver do not exactly match its bounds. Possible values are:
		#topLeft, #topRight, #bottomLeft, #bottomRight, #topCenter, #leftCenter, #rightCenter, #bottomCenter, #center 
	which align the receiver's bounds with the cell at the given point."
	self assureTableProperties cellPositioning: aSymbol.
	self layoutChanged.!

----- Method: Morph>>cellPositioningString: (in category 'layout-properties') -----
cellPositioningString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self cellPositioning!

----- Method: Morph>>cellSpacing (in category 'layout-properties') -----
cellSpacing
	"Layout specific. This property describes how the cell size for each element in a list should be computed.
		#globalRect - globally equal rectangular cells
		#globalSquare - globally equal square cells
		#localRect - locally (e.g., per row/column) equal rectangular cells
		#localSquare - locally (e.g., per row/column) equal square cells
		#none - cells are sized based on available row/column constraints
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props cellSpacing].!

----- Method: Morph>>cellSpacing: (in category 'layout-properties') -----
cellSpacing: aSymbol
	"Layout specific. This property describes how the cell size for each element in a list should be computed.
		#globalRect - globally equal rectangular cells
		#globalSquare - globally equal square cells
		#localRect - locally (e.g., per row/column) equal rectangular cells
		#localSquare - locally (e.g., per row/column) equal square cells
		#none - cells are sized based on available row/column constraints
	"
	self assureTableProperties cellSpacing: aSymbol.
	self layoutChanged.!

----- Method: Morph>>cellSpacingString: (in category 'layout-properties') -----
cellSpacingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self cellSpacing!

----- Method: Morph>>center (in category 'geometry') -----
center

	^ bounds center!

----- Method: Morph>>center: (in category 'geometry') -----
center: aPoint
	self position: (aPoint - (self extent // 2))!

----- Method: Morph>>changeCellInset: (in category 'layout-menu') -----
changeCellInset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self cellInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>changeClipLayoutCells (in category 'layout-menu') -----
changeClipLayoutCells
	self invalidRect: self fullBounds.
	self clipLayoutCells: self clipLayoutCells not.
	self invalidRect: self fullBounds.!

----- Method: Morph>>changeClipSubmorphs (in category 'drawing') -----
changeClipSubmorphs
	self clipSubmorphs: self clipSubmorphs not.!

----- Method: Morph>>changeColor (in category 'menus') -----
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!

----- Method: Morph>>changeColorTarget:selector:originalColor:hand: (in category 'meta-actions') -----
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 at -20) extent: 200]
								ifFalse: [anObject fullBoundsInWorld]]);
		yourself!

----- Method: Morph>>changeDirectionHandles (in category 'menus') -----
changeDirectionHandles
	^self wantsDirectionHandles: self wantsDirectionHandles not!

----- Method: Morph>>changeDisableTableLayout (in category 'layout-menu') -----
changeDisableTableLayout
	self disableTableLayout: self disableTableLayout not.
	self layoutChanged.!

----- Method: Morph>>changeDocumentAnchor (in category 'text-anchor') -----
changeDocumentAnchor
	"Change the anchor from/to document anchoring"

	| newType |
	newType := self textAnchorType == #document 
		ifTrue: [#paragraph]
		ifFalse: [ #document].
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]!

----- Method: Morph>>changeDragAndDrop (in category 'menus') -----
changeDragAndDrop
	^self enableDragNDrop: self dragNDropEnabled not!

----- Method: Morph>>changeInlineAnchor (in category 'text-anchor') -----
changeInlineAnchor
	"Change the anchor from/to line anchoring"

	| newType |
	newType := self textAnchorType == #inline 
				ifTrue: [#paragraph]
				ifFalse: [#inline]. 
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]!

----- Method: Morph>>changeLayoutInset: (in category 'layout-menu') -----
changeLayoutInset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self layoutInset: (newPoint - evt cursorPoint) asIntegerPoint // 5].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>changeListDirection: (in category 'layout-menu') -----
changeListDirection: aSymbol
	| listDir wrapDir |
	self listDirection: aSymbol.
	(self wrapDirection == #none) ifTrue:[^self].
	"otherwise automatically keep a valid table layout"
	listDir := self listDirection.
	wrapDir := self wrapDirection.
	(listDir == #leftToRight or:[listDir == #rightToLeft]) ifTrue:[
		wrapDir == #leftToRight ifTrue:[^self wrapDirection: #topToBottom].
		wrapDir == #rightToLeft ifTrue:[^self wrapDirection: #bottomToTop].
	] ifFalse:[
		wrapDir == #topToBottom ifTrue:[^self wrapDirection: #leftToRight].
		wrapDir == #bottomToTop ifTrue:[^self wrapDirection: #rightToLeft].
	].
!

----- Method: Morph>>changeMaxCellSize: (in category 'layout-menu') -----
changeMaxCellSize: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self maxCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>changeMinCellSize: (in category 'layout-menu') -----
changeMinCellSize: evt
	| handle |
	handle := HandleMorph new forEachPointDo:[:newPoint |
		self minCellSize: (newPoint - evt cursorPoint) asIntegerPoint].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>changeNoLayout (in category 'layout-menu') -----
changeNoLayout
	self layoutPolicy ifNil:[^self]. "already no layout"
	self layoutPolicy: nil.
	self layoutChanged.!

----- Method: Morph>>changeParagraphAnchor (in category 'text-anchor') -----
changeParagraphAnchor
	"Change the anchor from/to paragraph anchoring"

	| newType |
	newType := self textAnchorType == #paragraph 
		ifTrue: [#document]
		ifFalse: [#paragraph].
	owner isTextMorph 
		ifTrue: 
			[owner 
				anchorMorph: self
				at: self position
				type: newType]!

----- Method: Morph>>changeProportionalLayout (in category 'layout-menu') -----
changeProportionalLayout
	| layout |
	((layout := self layoutPolicy) notNil and:[layout isProportionalLayout])
		ifTrue:[^self]. "already proportional layout"
	self layoutPolicy: ProportionalLayout new.
	self layoutChanged.!

----- Method: Morph>>changeReverseCells (in category 'layout-menu') -----
changeReverseCells
	self reverseTableCells: self reverseTableCells not.!

----- Method: Morph>>changeRubberBandCells (in category 'layout-menu') -----
changeRubberBandCells
	self rubberBandCells: self rubberBandCells not.!

----- Method: Morph>>changeShadowColor (in category 'drop shadows') -----
changeShadowColor
	"Change the shadow color of the receiver -- triggered, e.g. from a menu"

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

----- Method: Morph>>changeTableLayout (in category 'layout-menu') -----
changeTableLayout
	| layout |
	((layout := self layoutPolicy) notNil and:[layout isTableLayout])
		ifTrue:[^self]. "already table layout"
	self layoutPolicy: TableLayout new.
	self layoutChanged.!

----- Method: Morph>>changed (in category 'updating') -----
changed
	"Report that the area occupied by this morph should be redrawn."
	^fullBounds 
		ifNil:[self invalidRect: self outerBounds]
		ifNotNil:[self invalidRect: fullBounds]!

----- Method: Morph>>chooseNewGraphic (in category 'menus') -----
chooseNewGraphic
	"Used by any morph that can be represented by a graphic"
	self chooseNewGraphicCoexisting: false
!

----- Method: Morph>>chooseNewGraphicCoexisting: (in category 'menus') -----
chooseNewGraphicCoexisting: aBoolean 
	"Allow the user to choose a different form for her form-based morph"
	| replacee aGraphicalMenu |
	aGraphicalMenu := GraphicalMenu new
				initializeFor: self
				withForms: self reasonableForms
				coexist: aBoolean.
	aBoolean
		ifTrue: [self primaryHand attachMorph: aGraphicalMenu]
		ifFalse: [replacee := self topRendererOrSelf.
			replacee owner replaceSubmorph: replacee by: aGraphicalMenu]!

----- Method: Morph>>chooseNewGraphicFromHalo (in category 'menus') -----
chooseNewGraphicFromHalo
	"Allow the user to select a changed graphic to replace the one in the receiver"

	self currentWorld abandonAllHalos.
	self chooseNewGraphicCoexisting: true
!

----- Method: Morph>>clearArea (in category 'accessing') -----
clearArea
	"Answer the clear area of the receiver. It means the area free  
	of docking bars."
	| visTop visBottom visLeft visRight |

	visTop := self top.
	visBottom := self bottom.
	visLeft := self left.
	visRight := self right.

	self dockingBars
		do: [:each | 
			(each isAdheringToTop and: [each bottom > visTop])
				ifTrue: [visTop := each bottom].

			(each isAdheringToBottom and: [each top < visBottom])
				ifTrue: [visBottom := each top].

			(each isAdheringToLeft and: [each right > visLeft])
				ifTrue: [visLeft := each right].

			(each isAdheringToRight and: [each left < visRight])
				ifTrue: [visRight := each left]
		].

	^ Rectangle
		left: visLeft
		right: visRight
		top: visTop
		bottom: visBottom
!

----- Method: Morph>>click (in category 'event handling') -----
click
	"Pretend the user clicked on me."

	(self handlesMouseDown: nil) ifTrue: [
		self mouseDown: nil.
		self mouseUp: nil].!

----- Method: Morph>>click: (in category 'event handling') -----
click: evt
	"Handle a single-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing.
	LC 2/14/2000 08:32 - added: EventHandler notification"

	self eventHandler ifNotNil:
		[self eventHandler click: evt fromMorph: self].!

----- Method: Morph>>clipLayoutCells (in category 'drawing') -----
clipLayoutCells
	"Drawing/layout specific. If this property is set, clip the  
	submorphs of the receiver by its cell bounds."
	^ self
		valueOfProperty: #clipLayoutCells
		ifAbsent: [false]!

----- Method: Morph>>clipLayoutCells: (in category 'drawing') -----
clipLayoutCells: aBool
	"Drawing/layout specific. If this property is set, clip the submorphs of the receiver by its cell bounds."
	aBool == false
		ifTrue:[self removeProperty: #clipLayoutCells]
		ifFalse:[self setProperty: #clipLayoutCells toValue: aBool].
	self changed.!

----- Method: Morph>>clipSubmorphs (in category 'drawing') -----
clipSubmorphs
	"Drawing specific. If this property is set, clip the receiver's  
	submorphs to the receiver's clipping bounds."
	
	extension ifNil: [^false].
	^ self
		valueOfProperty: #clipSubmorphs
		ifAbsent: [false]!

----- Method: Morph>>clipSubmorphs: (in category 'drawing') -----
clipSubmorphs: aBool
	"Drawing specific. If this property is set, clip the receiver's submorphs to the receiver's clipping bounds."
	self invalidRect: self fullBounds.
	aBool == false
		ifTrue:[self removeProperty: #clipSubmorphs]
		ifFalse:[self setProperty: #clipSubmorphs toValue: aBool].
	self invalidRect: self fullBounds.!

----- Method: Morph>>clipText (in category 'printing') -----
clipText
	"Copy the text in the receiver or in its submorphs to the clipboard"
	| content |
	"My own text"
	content := self userString.
	"Or in my submorphs"
	content ifNil: [
		| list |
		list := self allStringsAfter: nil.
		list notEmpty ifTrue: [
			content := String streamContents: [:stream |
				list do: [:each | stream nextPutAll: each; cr]]]].
	"Did we find something?"
	content
		ifNil: [self flash "provide feedback"]
		ifNotNil: [Clipboard clipboardText: content].!

----- Method: Morph>>clippingBounds (in category 'drawing') -----
clippingBounds
	"Return the bounds to which any submorphs should be clipped if the property is set"
	^self innerBounds!

----- Method: Morph>>collapse (in category 'menus') -----
collapse
	CollapsedMorph new beReplacementFor: self!

----- Method: Morph>>color (in category 'accessing') -----
color

	^ color 	"has already been set to ((self valueOfProperty: #fillStyle) asColor)"!

----- Method: Morph>>color: (in category 'accessing') -----
color: aColor
	"Set the receiver's color.  Directly set the color if appropriate, else go by way of fillStyle"

	(aColor isColor or: [aColor isKindOf: InfiniteForm]) ifFalse:[^ self fillStyle: aColor].
	color = aColor ifFalse:
		[self removeProperty: #fillStyle.
		color := aColor.
		self changed]!

----- Method: Morph>>color:sees: (in category 'geometry eToy') -----
color: sensitiveColor sees: soughtColor 
	"Return true if any of my pixels of sensitiveColor intersect with pixels of soughtColor."

	"Make a mask with black where sensitiveColor is, white elsewhere"

	| myImage sensitivePixelMask map patchBelowMe tfm morphAsFlexed i1 pasteUp |
	pasteUp := self world ifNil: [ ^false ].
	tfm := self transformFrom: pasteUp.
	morphAsFlexed := tfm isIdentity 
				ifTrue: [self]
				ifFalse: [TransformationMorph new flexing: self clone byTransformation: tfm].
	myImage := morphAsFlexed imageForm offset: 0 @ 0.
	sensitivePixelMask := Form extent: myImage extent depth: 1.
	"ensure at most a 16-bit map"
	map := Bitmap new: (1 bitShift: (myImage depth - 1 min: 15)).
	map at: (i1 := sensitiveColor indexInMap: map) put: 1.
	sensitivePixelMask 
		copyBits: sensitivePixelMask boundingBox
		from: myImage form
		at: 0 @ 0
		colorMap: map.

	"get an image of the world below me"
	patchBelowMe := pasteUp 
				patchAt: morphAsFlexed fullBounds
				without: self
				andNothingAbove: false.
	"
sensitivePixelMask displayAt: 0 at 0.
patchBelowMe displayAt: 100 at 0.
"
	"intersect world pixels of the color we're looking for with the sensitive pixels"
	map at: i1 put: 0.	"clear map and reuse it"
	map at: (soughtColor indexInMap: map) put: 1.
	sensitivePixelMask 
		copyBits: patchBelowMe boundingBox
		from: patchBelowMe
		at: 0 @ 0
		clippingBox: patchBelowMe boundingBox
		rule: Form and
		fillColor: nil
		map: map.
	"
sensitivePixelMask displayAt: 200 at 0.
"
	^(sensitivePixelMask tallyPixelValues second) > 0!

----- Method: Morph>>colorChangedForSubmorph: (in category 'change reporting') -----
colorChangedForSubmorph: aSubmorph
	"The color associated with aSubmorph was changed through the UI; react if needed"!

----- Method: Morph>>colorForInsets (in category 'accessing') -----
colorForInsets
	"Return the color to be used for shading inset borders.  The default is my own color, but it might want to be, eg, my owner's color.  Whoever's color ends up prevailing, the color itself gets the last chance to determine, so that when, for example, an InfiniteForm serves as the color, callers won't choke on some non-Color object being returned"
	(color isColor and:[color isTransparent and:[owner notNil]]) ifTrue:[^owner colorForInsets].
	^ color colorForInsets
!

----- Method: Morph>>colorString: (in category 'printing') -----
colorString: aColor 
	aColor ifNil: [^'nil'].
	Color colorNames 
		do: [:colorName | aColor = (Color perform: colorName) ifTrue: [^'Color ' , colorName]].
	^aColor storeString!

----- Method: Morph>>colorUnder (in category 'geometry eToy') -----
colorUnder
	"Return the color of under the receiver's center."

	self isInWorld
		ifTrue: [^ self world colorAt: (self pointInWorld: self referencePosition) belowMorph: self]
		ifFalse: [^ Color black].
!

----- Method: Morph>>comeToFront (in category 'submorphs-add/remove') -----
comeToFront
	| outerMorph |
	outerMorph := self topRendererOrSelf.
	(outerMorph owner isNil or: [outerMorph owner hasSubmorphs not]) 
		ifTrue: [^self].
	outerMorph owner firstSubmorph == outerMorph 
		ifFalse: [outerMorph owner addMorphFront: outerMorph]!

----- Method: Morph>>comeToFrontAndAddHalo (in category 'halos and balloon help') -----
comeToFrontAndAddHalo
	self comeToFront.
	self addHalo!

----- Method: Morph>>commandHistory (in category 'undo') -----
commandHistory
	"Return the command history for the receiver"
	| w |
	(w := self world) ifNotNil:[^w commandHistory].
	(w := self currentWorld) ifNotNil:[^w commandHistory].
	^CommandHistory new. "won't really record anything but prevent breaking things"!

----- Method: Morph>>completeModificationHash (in category 'testing') -----
completeModificationHash

"World completeModificationHash"

	| resultSize result |
	resultSize := 10.
	result := ByteArray new: resultSize.
	self allMorphsDo: [ :each | | here | 
		here := each modificationHash.
		here withIndexDo: [ :ch :index | | i |
			i := index \\ resultSize + 1.
			result at: i put: ((result at: i) bitXor: ch asciiValue)
		].
	].
	^result!

----- Method: Morph>>connections (in category 'accessing') -----
connections
	"Empty method in absence of connectors"
	^ #()!

----- Method: Morph>>constructorString (in category 'printing') -----
constructorString

	^ String streamContents: [:s | self printConstructorOn: s indent: 0].
!

----- Method: Morph>>containingWindow (in category 'e-toy support') -----
containingWindow
	"Answer a window or window-with-mvc that contains the receiver"

	| component |
	component := self.
	component model isNil ifTrue: [component := self firstOwnerSuchThat: [:m| m model notNil]].
	^(component isNil or: [component isWindowForModel: component model])
		ifTrue: [component]
		ifFalse: [component firstOwnerSuchThat:[:m| m isWindowForModel: component model]]!

----- Method: Morph>>containsPoint: (in category 'geometry testing') -----
containsPoint: aPoint

	^ self bounds containsPoint: aPoint!

----- Method: Morph>>containsPoint:event: (in category 'events-processing') -----
containsPoint: aPoint event: anEvent
	"Return true if aPoint is considered to be inside the receiver for the given event.
	The default implementation treats locked children as integral part of their owners."
	(self fullBounds containsPoint: aPoint) ifFalse:[^false].
	(self containsPoint: aPoint) ifTrue:[^true].
	self submorphsDo:[:m|
		(m isLocked and:[m fullContainsPoint: 
			((m transformedFrom: self) globalPointToLocal: aPoint)]) ifTrue:[^true]].
	^false!

----- Method: Morph>>copy (in category 'copying') -----
copy

	^ self veryDeepCopy!

----- Method: Morph>>copyToPasteBuffer: (in category 'meta-actions') -----
copyToPasteBuffer: evt
	self okayToDuplicate ifTrue:[evt hand copyToPasteBuffer: self].!

----- Method: Morph>>copyWithoutSubmorph: (in category 'submorphs-add/remove') -----
copyWithoutSubmorph: sub
	"Needed to get a morph to draw without one of its submorphs.
	NOTE:  This must be thrown away immediately after use."
	^ self clone privateSubmorphs: (submorphs copyWithout: sub)!

----- Method: Morph>>cornerStyle (in category 'visual properties') -----
cornerStyle
	"Returns one of the following symbols:
		#square
		#rounded
	according to the current corner style."

	^ self valueOfProperty: #cornerStyle ifAbsent: [#square]!

----- Method: Morph>>cornerStyle: (in category 'rounding') -----
cornerStyle: aSymbol
	"This method makes it possible to set up desired corner style. aSymbol has to be one of:
		#square
		#rounded"

	aSymbol == #square
		ifTrue:[self removeProperty: #cornerStyle]
		ifFalse:[self setProperty: #cornerStyle toValue: aSymbol].
	self changed!

----- Method: Morph>>couldHaveRoundedCorners (in category 'accessing') -----
couldHaveRoundedCorners
	^ true!

----- Method: Morph>>couldMakeSibling (in category 'testing') -----
couldMakeSibling
	"Answer whether it is appropriate to ask the receiver to make a sibling"

	^ true!

----- Method: Morph>>currentPlayerDo: (in category 'e-toy support') -----
currentPlayerDo: aBlock
	"If the receiver is a viewer/scriptor associated with a current Player object, evaluate the given block against that object"!

----- Method: Morph>>cursor (in category 'e-toy support') -----
cursor
	"vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"

	^ 1!

----- Method: Morph>>cursor: (in category 'e-toy support') -----
cursor: aNumber
	"vacuous backstop in case it gets sent to a morph that doesn't know what to do with it"
!

----- Method: Morph>>cursorPoint (in category 'event handling') -----
cursorPoint
	^ self currentHand lastEvent cursorPoint!

----- Method: Morph>>decimalPlacesForGetter: (in category 'e-toy support') -----
decimalPlacesForGetter: aGetter
	"Answer the decimal places I prefer for showing a slot with the given getter, or nil if none"

	| decimalPrefs |
	decimalPrefs := self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsent: [^ nil].
	^ decimalPrefs at: aGetter ifAbsent: [nil]!

----- Method: Morph>>deepCopy (in category 'copying') -----
deepCopy

	self error: 'Please use veryDeepCopy'.
!

----- Method: Morph>>defaultArrowheadSize (in category 'menus') -----
defaultArrowheadSize
	
	^ self class defaultArrowheadSize!

----- Method: Morph>>defaultBalloonColor (in category 'halos and balloon help') -----
defaultBalloonColor
	^ Display depth <= 2
		ifTrue: [Color white]
		ifFalse: [BalloonMorph balloonColor]!

----- Method: Morph>>defaultBalloonFont (in category 'halos and balloon help') -----
defaultBalloonFont
	^ BalloonMorph balloonFont!

----- Method: Morph>>defaultBitmapFillForm (in category 'visual properties') -----
defaultBitmapFillForm
	^ImageMorph defaultForm.
!

----- Method: Morph>>defaultBounds (in category 'initialization') -----
defaultBounds
"answer the default bounds for the receiver"
	^ 0 @ 0 corner: 50 @ 40!

----- Method: Morph>>defaultColor (in category 'initialization') -----
defaultColor
	"answer the default color/fill style for the receiver"
	^ Color blue!

----- Method: Morph>>defaultEventDispatcher (in category 'events-processing') -----
defaultEventDispatcher
	"Return the default event dispatcher to use with events that are directly sent to the receiver"
	^MorphicEventDispatcher new!

----- Method: Morph>>defaultLabelForInspector (in category 'user interface') -----
defaultLabelForInspector
	"Answer the default label to be used for an Inspector window on the receiver."
	^ super printString truncateTo: 40!

----- Method: Morph>>defaultNameStemForInstances (in category 'accessing') -----
defaultNameStemForInstances
	^self class name!

----- Method: Morph>>defaultValueOrNil (in category 'e-toy support') -----
defaultValueOrNil
	"If the receiver has a property named #defaultValue, return that property's value, else return nil"

	^ self valueOfProperty: #defaultValue ifAbsent: [nil]!

----- Method: Morph>>defersHaloOnClickTo: (in category 'halos and balloon help') -----
defersHaloOnClickTo: aSubMorph
	"If a cmd-click on aSubMorph would make it a preferred recipient of the halo, answer true"
	"May want to add a way (via a property) for morphs to assert true here -- this would let certain kinds of morphs that are unusually reluctant to take the halo on initial click"

	^ false
	!

----- Method: Morph>>defineTempCommand (in category 'debug and other') -----
defineTempCommand
	"To use this, comment out what's below here, and substitute your own code.
You will then be able to invoke it from the standard debugging menus.  If invoked from the world menu, you'll always get it invoked on behalf of the world, but if invoked from an individual morph's meta-menu, it will be invoked on behalf of that individual morph.

Note that you can indeed reimplement tempCommand in an individual morph's class if you wish"

	ToolSet browse: Morph
		selector: #tempCommand!

----- Method: Morph>>degreesOfFlex (in category 'geometry eToy') -----
degreesOfFlex
	"Return any rotation due to flexing"
	"NOTE: because renderedMorph, which is used by the halo to set heading, goes down through dropShadows as well as transformations, we need this method (and its other implems) to come back up through such a chain."
	^ 0.0!

----- Method: Morph>>delete (in category 'submorphs-add/remove') -----
delete
	"Remove the receiver as a submorph of its owner and make its 
	new owner be nil."

	| aWorld |
	self removeHalo.
	aWorld := self world ifNil: [World].
	"Terminate genie recognition focus"
	"I encountered a case where the hand was nil, so I put in a little 
	protection - raa "
	" This happens when we are in an MVC project and open
	  a morphic window. - BG "
	aWorld ifNotNil:
	  [self disableSubmorphFocusForHand: self activeHand.
	  self activeHand releaseKeyboardFocus: self;
		  releaseMouseFocus: self.].
	owner ifNotNil:[ self privateDelete.
		self player ifNotNil: [ :player |
			"Player must be notified"
			player noteDeletionOf: self fromWorld: aWorld]].!

----- Method: Morph>>deleteAnyMouseActionIndicators (in category 'debug and other') -----
deleteAnyMouseActionIndicators

	self changed.
	(self valueOfProperty: #mouseActionIndicatorMorphs ifAbsent: [#()]) do: [ :each |
		each deleteWithSiblings		"one is probably enough, but be safe"
	].
	self removeProperty: #mouseActionIndicatorMorphs.
	self hasRolloverBorder: false.
	self removeProperty: #rolloverWidth.
	self removeProperty: #rolloverColor.
	self layoutChanged.
	self changed.

!

----- Method: Morph>>deleteBalloon (in category 'halos and balloon help') -----
deleteBalloon
	"If I am showing a balloon, delete it."
	| w |
	w := self world ifNil:[^self].
	w deleteBalloonTarget: self.!

----- Method: Morph>>deleteDockingBars (in category 'submorphs-add/remove') -----
deleteDockingBars
	"Delete the receiver's docking bars"
	self dockingBars
		do: [:each | each delete]!

----- Method: Morph>>deleteSubmorphsWithProperty: (in category 'submorphs-add/remove') -----
deleteSubmorphsWithProperty: aSymbol
	submorphs copy do:
		[:m | (m hasProperty: aSymbol) ifTrue: [m delete]]!

----- Method: Morph>>demandsBoolean (in category 'classification') -----
demandsBoolean
	"Answer whether the receiver will only accept a drop if it is boolean-valued.  Particular to tile-scripting."

	^ self hasProperty: #demandsBoolean!

----- Method: Morph>>demandsThumbnailing (in category 'thumbnail') -----
demandsThumbnailing
	"Answer whether the receiver, if in a thumbnailable parts bin, wants to be thumbnailed whether or not size requires it"

	^ false!

----- Method: Morph>>disableDragNDrop (in category 'dropping/grabbing') -----
disableDragNDrop
	self enableDragNDrop: false!

----- Method: Morph>>disableSubmorphFocusForHand: (in category 'dispatching') -----
disableSubmorphFocusForHand: aHandMorph
	"Check whether this morph or any of its submorph has the Genie focus.
	If yes, disable it."
!

----- Method: Morph>>disableTableLayout (in category 'layout-properties') -----
disableTableLayout
	"Layout specific. Disable laying out the receiver in table layout"
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props disableTableLayout].!

----- Method: Morph>>disableTableLayout: (in category 'layout-properties') -----
disableTableLayout: aBool
	"Layout specific. Disable laying out the receiver in table layout"
	self assureLayoutProperties disableTableLayout: aBool.
	self layoutChanged.!

----- Method: Morph>>dismissMorph (in category 'meta-actions') -----
dismissMorph
	"This is called from an explicit halo destroy/delete action."

	| w |
	w := self world ifNil:[^self].
	w abandonAllHalos; stopStepping: self.
	self delete!

----- Method: Morph>>dismissMorph: (in category 'meta-actions') -----
dismissMorph: evt
	self dismissMorph!

----- Method: Morph>>dismissViaHalo (in category 'submorphs-add/remove') -----
dismissViaHalo
	"The user has clicked in the delete halo-handle.  This provides a hook in case some concomitant action should be taken, or if the particular morph is not one which should be put in the trash can, for example."

	| cmd |
	self setProperty: #lastPosition toValue: self positionInWorld.
	self dismissMorph.
	Preferences preserveTrash ifTrue: [ 
		Preferences slideDismissalsToTrash
			ifTrue:[self slideToTrash: nil]
			ifFalse:[TrashCanMorph moveToTrash: self].
	].

	cmd := Command new cmdWording: 'dismiss ' translated, self externalName.
	cmd undoTarget: ActiveWorld selector: #reintroduceIntoWorld: argument: self.
	cmd redoTarget: ActiveWorld selector: #onceAgainDismiss: argument: self.
	ActiveWorld rememberCommand: cmd!

----- Method: Morph>>doButtonAction (in category 'button') -----
doButtonAction
	"If the receiver has a button-action defined, do it now.  The default button action of any morph is, well, to do nothing.  Note that there are several ways -- too many ways -- for morphs to have button-like actions.  This one refers not to the #mouseUpCodeToRun feature, nor does it refer to the Player-scripting mechanism.  Instead it is intended for morph classes whose very nature is to be buttons -- this method provides glue so that arbitrary buttons on the UI can be 'fired' programatticaly from user scripts"!

----- Method: Morph>>doCancel (in category 'user interface') -----
doCancel
	self delete!

----- Method: Morph>>doLayoutIn: (in category 'layout') -----
doLayoutIn: layoutBounds 
	"Compute a new layout based on the given layout bounds."

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

	| layout box priorBounds |
	priorBounds := self outerBounds.
	submorphs isEmpty ifTrue: [^fullBounds := priorBounds].
	"Send #ownerChanged to our children"
	submorphs do: [:m | m ownerChanged].
	layout := self layoutPolicy.
	layout ifNotNil: [layout layout: self in: layoutBounds].
	self adjustLayoutBounds.
	fullBounds := self privateFullBounds.
	box := self outerBounds.
	box = priorBounds 
		ifFalse: [self invalidRect: (priorBounds quickMerge: box)]!

----- Method: Morph>>doMenuItem: (in category 'menus') -----
doMenuItem: menuString
	| aMenu anItem aNominalEvent aHand |
	aMenu := self buildHandleMenu: (aHand := self currentHand).
	aMenu allMorphsDo: [:m | m step].  "Get wordings current"
	anItem := aMenu itemWithWording: menuString.
	anItem ifNil:
		[^ self player scriptingError: 'Menu item not found: ', menuString].
	aNominalEvent :=  MouseButtonEvent new
		setType: #mouseDown
		position: anItem bounds center
		which: 4 "red"
		buttons: 4 "red"
		hand: aHand
		stamp: nil.
	anItem invokeWithEvent: aNominalEvent!

----- Method: Morph>>dockingBars (in category 'submorphs-accessing') -----
dockingBars
	"Answer the receiver's dockingBars"
	^ self submorphs
		select: [:each | each isDockingBar]
!

----- Method: Morph>>doesBevels (in category 'accessing') -----
doesBevels
	"To return true means that this object can show bevelled borders, and
	therefore can accept, eg, #raised or #inset as valid borderColors.
	Must be overridden by subclasses that do not support bevelled borders."

	^ false!

----- Method: Morph>>doesOwnRotation (in category 'drawing') -----
doesOwnRotation
	"Some morphs don't want to TransformMorph to rotate their images, but we do"
	^ false!

----- Method: Morph>>doubleClick: (in category 'event handling') -----
doubleClick: evt
	"Handle a double-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing.
	LC 2/14/2000 08:32 - added: EventHandler notification"

	self eventHandler ifNotNil:
		[self eventHandler doubleClick: evt fromMorph: self].!

----- Method: Morph>>doubleClickTimeout: (in category 'event handling') -----
doubleClickTimeout: evt
	"Handle a double-click timeout event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	self eventHandler ifNotNil:
		[self eventHandler doubleClickTimeout: evt fromMorph: self].!

----- Method: Morph>>downshiftedNameOfObjectRepresented (in category 'naming') -----
downshiftedNameOfObjectRepresented
	"Answer the downshiped version of the external name of the object represented"

	^ self nameOfObjectRepresented asLowercase!

----- Method: Morph>>dragEnabled (in category 'dropping/grabbing') -----
dragEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."
	^(self valueOfProperty: #dragEnabled) == true
!

----- Method: Morph>>dragEnabled: (in category 'dropping/grabbing') -----
dragEnabled: aBool
	^self enableDrag: aBool!

----- Method: Morph>>dragNDropEnabled (in category 'dropping/grabbing') -----
dragNDropEnabled
	"Note: This method is only useful for dragEnabled == dropEnabled at all times"
	self separateDragAndDrop.
	^self dragEnabled and:[self dropEnabled]!

----- Method: Morph>>dragSelectionColor (in category 'dropping/grabbing') -----
dragSelectionColor
	^ Color magenta!

----- Method: Morph>>drawDropHighlightOn: (in category 'drawing') -----
drawDropHighlightOn: aCanvas
	self highlightedForDrop ifTrue: [
		aCanvas frameRectangle: self fullBounds color: self dropHighlightColor].!

----- Method: Morph>>drawDropShadowOn: (in category 'drawing') -----
drawDropShadowOn: aCanvas

	aCanvas 
		translateBy: self shadowOffset 
		during: [ :shadowCanvas |
			shadowCanvas shadowColor: self shadowColor.
			shadowCanvas roundCornersOf: self during: [ 
				(shadowCanvas isVisible: self bounds) ifTrue:
					[shadowCanvas fillRectangle: self bounds fillStyle: self fillStyle]]
		].
!

----- Method: Morph>>drawErrorOn: (in category 'drawing') -----
drawErrorOn: aCanvas
	"The morph (or one of its submorphs) had an error in its drawing method."
	aCanvas
		frameAndFillRectangle: bounds
		fillColor: Color red
		borderWidth: 1
		borderColor: Color yellow.
	aCanvas line: bounds topLeft to: bounds bottomRight width: 1 color: Color yellow.
	aCanvas line: bounds topRight to: bounds bottomLeft width: 1 color: Color yellow.!

----- Method: Morph>>drawMouseDownHighlightOn: (in category 'drawing') -----
drawMouseDownHighlightOn: aCanvas
	self highlightedForMouseDown ifTrue: [
		aCanvas frameRectangle: self fullBounds color: self color darker darker].!

----- Method: Morph>>drawOn: (in category 'drawing') -----
drawOn: aCanvas

	aCanvas fillRectangle: self bounds fillStyle: self fillStyle borderStyle: self borderStyle.
!

----- Method: Morph>>drawOnCanvas: (in category 'filter streaming') -----
drawOnCanvas: aCanvas
	^aCanvas fullDraw: self.
!

----- Method: Morph>>drawRolloverBorderOn: (in category 'drawing') -----
drawRolloverBorderOn: aCanvas 
	| colorToUse offsetToUse myShadow newForm f |
	colorToUse := self
				valueOfProperty: #rolloverColor
				ifAbsent: [Color blue alpha: 0.5].
	offsetToUse := self
				valueOfProperty: #rolloverWidth
				ifAbsent: [10 @ 10].
	self hasRolloverBorder: false.
	myShadow := self shadowForm.
	self hasRolloverBorder: true.
	myShadow offset: 0 @ 0.
	f := ColorForm extent: myShadow extent depth: 1.
	myShadow displayOn: f.
	f colors: {Color transparent. colorToUse}.
	newForm := Form extent: offsetToUse * 2 + myShadow extent depth: 32.
	(WarpBlt current toForm: newForm) sourceForm: f;
		 cellSize: 1;
		 combinationRule: 3;
		 copyQuad: f boundingBox innerCorners toRect: newForm boundingBox.
	aCanvas
		translateBy: offsetToUse negated
		during: [:shadowCanvas | 
			shadowCanvas shadowColor: colorToUse.
			shadowCanvas paintImage: newForm at: self position]!

----- Method: Morph>>drawSubmorphsOn: (in category 'drawing') -----
drawSubmorphsOn: aCanvas 
	"Display submorphs back to front"

	| drawBlock |
	submorphs isEmpty ifTrue: [^self].
	drawBlock := [:canvas | submorphs reverseDo: [:m | canvas fullDrawMorph: m]].
	self clipSubmorphs 
		ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock]
		ifFalse: [drawBlock value: aCanvas]!

----- Method: Morph>>dropEnabled (in category 'dropping/grabbing') -----
dropEnabled
	"Get this morph's ability to add and remove morphs via drag-n-drop."
	^(self valueOfProperty: #dropEnabled) == true
!

----- Method: Morph>>dropEnabled: (in category 'dropping/grabbing') -----
dropEnabled: aBool
	^self enableDrop: aBool!

----- Method: Morph>>dropFiles: (in category 'event handling') -----
dropFiles: anEvent
	"Handle a number of files dropped from the OS"
!

----- Method: Morph>>dropHighlightColor (in category 'dropping/grabbing') -----
dropHighlightColor
	^ Color blue!

----- Method: Morph>>dropSuccessColor (in category 'dropping/grabbing') -----
dropSuccessColor
	^ Color blue!

----- Method: Morph>>duplicate (in category 'copying') -----
duplicate
	"Make and return a duplicate of the receiver"

	| newMorph aName w aPlayer topRend |
	((topRend := self topRendererOrSelf) ~~ self) ifTrue: [^ topRend duplicate].

	self okayToDuplicate ifFalse: [^ self].
	aName := (w := self world) ifNotNil:
		[w nameForCopyIfAlreadyNamed: self].
	newMorph := self veryDeepCopy.
	aName ifNotNil: [newMorph setNameTo: aName].

	newMorph arrangeToStartStepping.
	newMorph privateOwner: nil. "no longer in world"
	newMorph isPartsDonor: false. "no longer parts donor"
	(aPlayer := newMorph player) belongsToUniClass ifTrue:
		[aPlayer class bringScriptsUpToDate].
	aPlayer ifNotNil: [ActiveWorld presenter flushPlayerListCache].
	^ newMorph!

----- Method: Morph>>duplicateMorph: (in category 'meta-actions') -----
duplicateMorph: evt
	"Make and return a duplicate of the receiver's argument"
	| dup |
	dup := self duplicate.
	evt hand grabMorph: dup from: owner. "duplicate was ownerless so use #grabMorph:from: here"
	^dup!

----- Method: Morph>>duplicateMorphCollection: (in category 'copying') -----
duplicateMorphCollection: aCollection
	"Make and return a duplicate of the receiver"

	| newCollection names |

	names := aCollection collect: [ :ea | | newMorph w |
		(w := ea world) ifNotNil:
			[w nameForCopyIfAlreadyNamed: ea].
	].

	newCollection := aCollection veryDeepCopy.

	newCollection with: names do: [ :newMorph :name |
		name ifNotNil: [ newMorph setNameTo: name ].
		newMorph arrangeToStartStepping.
		newMorph privateOwner: nil. "no longer in world"
		newMorph isPartsDonor: false. "no longer parts donor"
	].

	^newCollection!

----- Method: Morph>>duplicateMorphImage: (in category 'meta-actions') -----
duplicateMorphImage: evt 
	"Make and return a imageMorph of the receiver's argument imageForm"
	| dup |
	dup := self asSnapshotThumbnail withSnapshotBorder.
	dup bounds: self bounds.
	evt hand grabMorph: dup from: owner.
	"duplicate was ownerless so use #grabMorph:from: here"
	^ dup!

----- Method: Morph>>eToyRejectDropMorph:event: (in category 'WiW support') -----
eToyRejectDropMorph: morphToDrop event: evt

	| tm am |

	tm := TextMorph new 
		beAllFont: ((TextStyle named: Preferences standardEToysFont familyName) fontOfSize: 24);
		contents: 'GOT IT!!'.
	(am := AlignmentMorph new)
		color: Color yellow;
		layoutInset: 10;
		useRoundedCorners;
		vResizing: #shrinkWrap;
		hResizing: #shrinkWrap;
		addMorph: tm;
		fullBounds;
		position: (self bounds center - (am extent // 2));
		openInWorld: self world.
	SoundService default playSoundNamed: 'yum' ifAbsentReadFrom: 'yum.aif'.
	morphToDrop rejectDropMorphEvent: evt.		"send it back where it came from"
	am delete
!

----- Method: Morph>>editBalloonHelpContent: (in category 'halos and balloon help') -----
editBalloonHelpContent: aString
	| reply |
	reply := UIManager default
		multiLineRequest: 'Edit the balloon help text for ' translated, self externalName
		centerAt: Sensor cursorPoint
		initialAnswer: (aString ifNil: [self noHelpString] ifNotNil: [aString])
		answerHeight: 200.
	reply ifNil: [^ self].  "User cancelled out of the dialog"
	(reply isEmpty or: [reply asString = self noHelpString])
		ifTrue: [self setBalloonText: nil]
		ifFalse: [self setBalloonText: reply]!

----- Method: Morph>>editBalloonHelpText (in category 'halos and balloon help') -----
editBalloonHelpText
	"Modify the receiver's balloon help text."

	self editBalloonHelpContent: self balloonText!

----- Method: Morph>>embedInWindow (in category 'e-toy support') -----
embedInWindow

	| window worldToUse |

	worldToUse := self world.		"I'm assuming we are already in a world"
	window := (SystemWindow labelled: self defaultLabelForInspector) model: nil.
	window bounds: ((self position - ((0 at window labelHeight) + window borderWidth))
						corner: self bottomRight + window borderWidth).
	window addMorph: self frame: (0 at 0 extent: 1 at 1).
	window updatePaneColors.
	worldToUse addMorph: window.
	window activate!

----- Method: Morph>>embedInto: (in category 'meta-actions') -----
embedInto: evt
	"Embed the receiver into some other morph"
	|  target morphs |
	morphs := self potentialEmbeddingTargets.
	target := UIManager default 
		chooseFrom: (morphs collect:[:m| m knownName ifNil:[m class name asString]])
		values: self potentialEmbeddingTargets
		title: ('Place ', self externalName, ' in...').
	target ifNil:[^self].
	target addMorphFront: self fromWorldPosition: self positionInWorld.!

----- Method: Morph>>embeddedInMorphicWindowLabeled: (in category 'e-toy support') -----
embeddedInMorphicWindowLabeled: labelString
	| window |
	window := (SystemWindow labelled: labelString) model: nil.
	window setStripeColorsFrom: nil defaultBackgroundColor.
	window addMorph: self frame: (0 at 0 extent: 1 at 1).
	^ window!

----- Method: Morph>>enableDrag: (in category 'dropping/grabbing') -----
enableDrag: aBoolean
	self setProperty: #dragEnabled toValue: aBoolean!

----- Method: Morph>>enableDragNDrop (in category 'dropping/grabbing') -----
enableDragNDrop
	self enableDragNDrop: true!

----- Method: Morph>>enableDragNDrop: (in category 'dropping/grabbing') -----
enableDragNDrop: aBoolean
	"Set both properties at once"
	self separateDragAndDrop.
	self enableDrag: aBoolean.
	self enableDrop: aBoolean.!

----- Method: Morph>>enableDrop: (in category 'dropping/grabbing') -----
enableDrop: aBoolean
	self setProperty: #dropEnabled toValue: aBoolean!

----- Method: Morph>>eventHandler (in category 'accessing') -----
eventHandler
	"answer the receiver's eventHandler"
	^ extension ifNotNil: [extension eventHandler] !

----- Method: Morph>>eventHandler: (in category 'accessing') -----
eventHandler: anEventHandler 
	"Note that morphs can share eventHandlers and all is OK. "
	self assureExtension eventHandler: anEventHandler!

----- Method: Morph>>expandFullBoundsForDropShadow: (in category 'drawing') -----
expandFullBoundsForDropShadow: aRectangle
	"Return an expanded rectangle for an eventual drop shadow"
	| delta box |

	box := aRectangle.
	delta := self shadowOffset.
	box := delta x >= 0 
		ifTrue:[box right: aRectangle right + delta x]
		ifFalse:[box left: aRectangle left + delta x].
	box := delta y >= 0
		ifTrue:[box bottom: aRectangle bottom + delta y]
		ifFalse:[box top: aRectangle top + delta y].
	^box!

----- Method: Morph>>expandFullBoundsForRolloverBorder: (in category 'drawing') -----
expandFullBoundsForRolloverBorder: aRectangle
	| delta |
	delta := self valueOfProperty: #rolloverWidth ifAbsent: [10 at 10].
	^aRectangle expandBy: delta.

!

----- Method: Morph>>exportAsBMP (in category 'menus') -----
exportAsBMP
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.bmp'.
	fName isEmpty ifTrue:[^self].
	self imageForm writeBMPfileNamed: fName.!

----- Method: Morph>>exportAsGIF (in category 'menus') -----
exportAsGIF
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.gif'.
	fName isEmpty ifTrue:[^self].
	GIFReadWriter putForm: self imageForm onFileNamed: fName.!

----- Method: Morph>>exportAsJPEG (in category 'menus') -----
exportAsJPEG
	"Export the receiver's image as a JPEG"

	| fName |
	fName := UIManager default request: 'Please enter the name' translated initialAnswer: self externalName,'.jpeg'.
	fName isEmpty ifTrue: [^ self].
	self imageForm writeJPEGfileNamed: fName!

----- Method: Morph>>exportAsPNG (in category 'menus') -----
exportAsPNG
	| fName |
	fName := UIManager default request:'Please enter the name' translated initialAnswer: self externalName,'.png'.
	fName isEmpty ifTrue:[^self].
	PNGReadWriter putForm: self imageForm onFileNamed: fName.!

----- Method: Morph>>extension (in category 'accessing - extension') -----
extension
	"answer the recevier's extension"
	^ extension!

----- Method: Morph>>extent (in category 'geometry') -----
extent

	^ bounds extent!

----- Method: Morph>>extent: (in category 'geometry') -----
extent: aPoint

	(bounds extent closeTo: aPoint) ifTrue: [^ self].
	self changed.
	bounds := bounds topLeft extent: aPoint.
	self layoutChanged.
	self changed.
!

----- Method: Morph>>externalName (in category 'viewer') -----
externalName
	^ self knownName ifNil: [self innocuousName]!

----- Method: Morph>>fillStyle (in category 'visual properties') -----
fillStyle
	"Return the current fillStyle of the receiver."
	^ self
		valueOfProperty: #fillStyle
		ifAbsent: ["Workaround already converted morphs"
			color
				ifNil: [self defaultColor]]!

----- Method: Morph>>fillStyle: (in category 'visual properties') -----
fillStyle: aFillStyle
	"Set the current fillStyle of the receiver."
	self setProperty: #fillStyle toValue: aFillStyle.
	"Workaround for Morphs not yet converted"
	color := aFillStyle asColor.
	self changed.!

----- Method: Morph>>fillWithRamp:oriented: (in category 'visual properties') -----
fillWithRamp: rampSpecsOrColor oriented: aRatio 
	rampSpecsOrColor isColor
		ifTrue: [self color: rampSpecsOrColor".
			self borderColor: rampSpecsOrColor muchDarker"]
		ifFalse: [| fill | 
			fill := GradientFillStyle ramp: rampSpecsOrColor.
			fill origin: self bounds topLeft.
			fill direction: (self bounds extent * aRatio) truncated.
			fill radial: false.
			self fillStyle: fill.
			self borderColor: (rampSpecsOrColor first value mixed: 0.5 with: rampSpecsOrColor last value) muchDarker]!

----- Method: Morph>>findA: (in category 'submorphs-accessing') -----
findA: aClass
	"Return the first submorph of the receiver that is descended from the given class. Return nil if there is no such submorph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."

	^self submorphs
		detect: [:p | p isKindOf: aClass]
		ifNone: [nil]!

----- Method: Morph>>findDeepSubmorphThat:ifAbsent: (in category 'submorphs-accessing') -----
findDeepSubmorphThat: block1 ifAbsent: block2 
	self
		allMorphsDo: [:m | (block1 value: m)
				== true ifTrue: [^ m]].
	^ block2 value!

----- Method: Morph>>findDeeplyA: (in category 'submorphs-accessing') -----
findDeeplyA: aClass
	"Return a morph in the submorph tree of the receiver that is descended from the given class. Return nil if there is no such morph. Clients of this code should always check for a nil return value so that the code will be robust if the user takes the morph apart."

	^ (self allMorphs copyWithout: self)
		detect: [:p | p isKindOf: aClass]
		ifNone: [nil]!

----- Method: Morph>>findSubmorphBinary: (in category 'submorphs-accessing') -----
findSubmorphBinary: aBlock
	"Use binary search for finding a specific submorph of the receiver. Caller must be certain that the ordering holds for the submorphs."
	^submorphs findBinary: aBlock ifNone:[nil].!

----- Method: Morph>>firstClickTimedOut: (in category 'event handling') -----
firstClickTimedOut: evt
	"Useful for double-click candidates who want to know whether or not the click is a single or double. In this case, ignore the #click: and wait for either this or #doubleClick:"

!

----- Method: Morph>>firstOwnerSuchThat: (in category 'structure') -----
firstOwnerSuchThat: conditionBlock

	self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [^ m]].
	^ nil
!

----- Method: Morph>>firstSubmorph (in category 'submorphs-accessing') -----
firstSubmorph
	^submorphs first!

----- Method: Morph>>flash (in category 'macpal') -----
flash
	| c w |
	c := self color.
	self color: Color black.
	(w := self world) ifNotNil: [w displayWorldSafely].
	self color: c
!

----- Method: Morph>>flashBounds (in category 'drawing') -----
flashBounds
	"Flash the receiver's bounds  -- does not use the receiver's color, thus works with StringMorphs and SketchMorphs, etc., for which #flash is useless.  No senders initially, but useful to send this from a debugger or inspector"

	5 timesRepeat:
		[Display flash: self boundsInWorld  andWait: 120]!

----- Method: Morph>>formerOwner (in category 'dropping/grabbing') -----
formerOwner
	^self valueOfProperty: #formerOwner!

----- Method: Morph>>formerOwner: (in category 'dropping/grabbing') -----
formerOwner: aMorphOrNil 
	aMorphOrNil 
		ifNil: [self removeProperty: #formerOwner]
		ifNotNil: [self setProperty: #formerOwner toValue: aMorphOrNil]!

----- Method: Morph>>formerPosition (in category 'dropping/grabbing') -----
formerPosition
	^self valueOfProperty: #formerPosition!

----- Method: Morph>>formerPosition: (in category 'dropping/grabbing') -----
formerPosition: formerPosition 
	formerPosition 
		ifNil: [self removeProperty: #formerPosition]
		ifNotNil: [self setProperty: #formerPosition toValue: formerPosition]!

----- Method: Morph>>forwardDirection (in category 'accessing') -----
forwardDirection
	"Return the receiver's forward direction (in eToy terms)"
	^self valueOfProperty: #forwardDirection ifAbsent:[0.0]!

----- Method: Morph>>forwardDirection: (in category 'geometry eToy') -----
forwardDirection: newDirection
	"Set the receiver's forward direction (in eToy terms)"
	self setProperty: #forwardDirection toValue: newDirection.!

----- Method: Morph>>fullBounds (in category 'layout') -----
fullBounds
	"Return the bounding box of the receiver and all its children. Recompute the layout if necessary."
	fullBounds ifNotNil:[^fullBounds].
	"Errors at this point can be critical so make sure we catch 'em all right"
	[self doLayoutIn: self layoutBounds] on: Error do:[:ex|
		"This should do it unless you don't screw up the bounds"
		fullBounds := bounds.
		ex pass].
	^fullBounds!

----- Method: Morph>>fullBoundsInWorld (in category 'geometry') -----
fullBoundsInWorld
	^self bounds: self fullBounds in: self world!

----- Method: Morph>>fullContainsPoint: (in category 'geometry testing') -----
fullContainsPoint: aPoint

	(self fullBounds containsPoint: aPoint) ifFalse: [^ false].  "quick elimination"
	(self containsPoint: aPoint) ifTrue: [^ true].  "quick acceptance"
	submorphs do: [:m | (m fullContainsPoint: aPoint) ifTrue: [^ true]].
	^ false
!

----- Method: Morph>>fullCopy (in category 'copying') -----
fullCopy
	"Deprecated, but maintained for backward compatibility with existing code (no senders in the base 3.0 image).   Calls are revectored to #veryDeepCopy, but note that #veryDeepCopy does not do exactly the same thing that the original #fullCopy did, so beware!!"

	^ self veryDeepCopy!

----- Method: Morph>>fullDrawOn: (in category 'drawing') -----
fullDrawOn: aCanvas
	"Draw the full Morphic structure on the given Canvas"

	self visible ifFalse: [^ self].
	(aCanvas isVisible: self fullBounds) ifFalse:[^self].
	(self hasProperty: #errorOnDraw) ifTrue:[^self drawErrorOn: aCanvas].
	"Note: At some point we should generalize this into some sort of 
	multi-canvas so that we can cross-optimize some drawing operations."
	"Pass 1: Draw eventual drop-shadow"
	self hasDropShadow ifTrue: [self drawDropShadowOn: aCanvas].
	(self hasRolloverBorder and: [(aCanvas seesNothingOutside: self bounds) not])
		ifTrue: [self drawRolloverBorderOn: aCanvas].

	"Pass 2: Draw receiver itself"
	aCanvas roundCornersOf: self during:[
		(aCanvas isVisible: self bounds) ifTrue:[aCanvas drawMorph: self].
		self drawSubmorphsOn: aCanvas.
		self drawDropHighlightOn: aCanvas.
		self drawMouseDownHighlightOn: aCanvas].!

----- Method: Morph>>fullLoadCachedState (in category 'caching') -----
fullLoadCachedState
	"Load the cached state of the receiver and its full submorph tree."

	self allMorphsDo: [:m | m loadCachedState].
!

----- Method: Morph>>fullPrintOn: (in category 'printing') -----
fullPrintOn: aStream

	aStream nextPutAll: self class name , ' newBounds: (';
		print: bounds;
		nextPutAll: ') color: ' , (self colorString: color)!

----- Method: Morph>>fullReleaseCachedState (in category 'caching') -----
fullReleaseCachedState
	"Release the cached state of the receiver and its full submorph tree."

	self allMorphsDo: [:m | m releaseCachedState].
!

----- Method: Morph>>getIndexInOwner (in category 'geometry eToy') -----
getIndexInOwner
	"Answer which position the receiver holds in its owner's hierarchy"

	"NB: There is some concern about submorphs that aren't really to be counted, such as a background morph of a playfield."

	| container topRenderer |
	container := (topRenderer := self topRendererOrSelf) owner.
	^ container submorphIndexOf: topRenderer.!

----- Method: Morph>>getNumericValue (in category 'e-toy support') -----
getNumericValue
	"Only certain kinds of morphs know how to deal with this frontally; here we provide support for a numeric property of any morph"

	^ self valueOfProperty: #numericValue ifAbsent: [0]!

----- Method: Morph>>globalPointToLocal: (in category 'geometry') -----
globalPointToLocal: aPoint
	^self point: aPoint from: nil!

----- Method: Morph>>goBehind (in category 'submorphs-add/remove') -----
goBehind

	owner addMorphNearBack: self.
!

----- Method: Morph>>goHome (in category 'geometry eToy') -----
goHome
	| box fb |
	owner isInMemory ifFalse: [^ self].
	owner isNil ifTrue: [^ self].
	self visible ifFalse: [^ self].

	box := owner visibleClearArea.
	fb := self fullBounds.

	fb left < box left
		ifTrue: [self left: box left - fb left + self left].
	fb right > box right
		ifTrue: [self right: box right - fb right + self right].

	fb top < box top
		ifTrue: [self top: box top - fb top + self top].
	fb bottom > box bottom
		ifTrue: [self bottom: box bottom - fb bottom + self bottom].
!

----- Method: Morph>>grabMorph: (in category 'meta-actions') -----
grabMorph: evt

	evt hand grabMorph: self!

----- Method: Morph>>grabTransform (in category 'dropping/grabbing') -----
grabTransform
	"Return the transform for the receiver which should be applied during grabbing"
	^owner ifNil:[IdentityTransform new] ifNotNil:[owner grabTransform]!

----- Method: Morph>>gridFormOrigin:grid:background:line: (in category 'e-toy support') -----
gridFormOrigin: origin grid: smallGrid background: backColor line: lineColor

	| bigGrid gridForm gridOrigin |
	gridOrigin := origin \\ smallGrid.
	bigGrid := (smallGrid asPoint x) @ (smallGrid asPoint y).
	gridForm := Form extent: bigGrid depth: Display depth.
	backColor ifNotNil: [gridForm fillWithColor: backColor].
	gridOrigin x to: gridForm width by: smallGrid x do:
		[:x | gridForm fill: (x at 0 extent: 1 at gridForm height) fillColor: lineColor].
	gridOrigin y to: gridForm height by: smallGrid y do:
		[:y | gridForm fill: (0 at y extent: gridForm width at 1) fillColor: lineColor].
	^ InfiniteForm with: gridForm
!

----- Method: Morph>>gridPoint: (in category 'geometry') -----
gridPoint: ungriddedPoint

	^ ungriddedPoint!

----- Method: Morph>>griddedPoint: (in category 'geometry') -----
griddedPoint: ungriddedPoint

	| griddingContext |
	self flag: #arNote. "Used by event handling - should transform to pasteUp for gridding"
	(griddingContext := self pasteUpMorph) ifNil: [^ ungriddedPoint].
	^ griddingContext gridPoint: ungriddedPoint!

----- Method: Morph>>hResizing (in category 'layout-properties') -----
hResizing
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#rigid] ifNotNil:[props hResizing].!

----- Method: Morph>>hResizing: (in category 'layout-properties') -----
hResizing: aSymbol
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	self assureLayoutProperties hResizing: aSymbol.
	self layoutChanged.
!

----- Method: Morph>>hResizingString: (in category 'layout-properties') -----
hResizingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self hResizing!

----- Method: Morph>>halo (in category 'halos and balloon help') -----
halo

	(self outermostWorldMorph ifNil: [^nil]) haloMorphs do: [:h | h target == self ifTrue: [^ h]].
	^ nil!

----- Method: Morph>>haloClass (in category 'halos and balloon help') -----
haloClass
	"Answer the name of the desired kind of HaloMorph to launch on behalf of the receiver"

	^ #HaloMorph
!

----- Method: Morph>>haloDelayTime (in category 'halos and balloon help') -----
haloDelayTime
	"Return the number of milliseconds before a halo should be put up on the receiver. The halo will only be put up if the receiver responds to #wantsHalo by returning true."
	^800!

----- Method: Morph>>handUserASibling (in category 'e-toy support') -----
handUserASibling
	"Make and hand the user a sibling instance.  Force the creation of a uniclass at this point if one does not already exist for the receiver."

	| topRend |
	topRend := self topRendererOrSelf.
	topRend couldMakeSibling ifFalse: [^ Beeper beep].

	topRend assuredPlayer assureUniClass.
	(topRend makeSiblings: 1) first openInHand!

----- Method: Morph>>handleDropFiles: (in category 'events-processing') -----
handleDropFiles: anEvent
	"Handle a drop from the OS."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(self wantsDropFiles: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	self dropFiles: anEvent.
!

----- Method: Morph>>handleDropMorph: (in category 'events-processing') -----
handleDropMorph: anEvent
	"Handle a dropping morph."
	| aMorph localPt |
	aMorph := anEvent contents.
	"Do a symmetric check if both morphs like each other"
	((self wantsDroppedMorph: aMorph event: anEvent)	"I want her"
		and: [aMorph wantsToBeDroppedInto: self])		"she wants me"
		ifFalse: [aMorph removeProperty: #undoGrabCommand.
				^ self].
	anEvent wasHandled: true.
	"Transform the morph into the receiver's coordinate frame. This is currently incomplete since it only takes the offset into account where it really should take the entire transform."
	localPt := (self transformedFrom: anEvent hand world) "full transform down"
				globalPointToLocal: aMorph referencePosition.
	aMorph referencePosition: localPt.
	self acceptDroppingMorph: aMorph event: anEvent.
	aMorph justDroppedInto: self event: anEvent.
!

----- Method: Morph>>handleEvent: (in category 'events-processing') -----
handleEvent: anEvent
	"Handle the given event"
	^anEvent sentTo: self.!

----- Method: Morph>>handleFocusEvent: (in category 'events-processing') -----
handleFocusEvent: anEvent
	"Handle the given event. This message is sent if the receiver currently has the focus and is therefore receiving events directly from some hand."
	^self handleEvent: anEvent!

----- Method: Morph>>handleKeyDown: (in category 'events-processing') -----
handleKeyDown: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self].
	(self handlesKeyboard: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	^self keyDown: anEvent!

----- Method: Morph>>handleKeyUp: (in category 'events-processing') -----
handleKeyUp: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self].
	(self handlesKeyboard: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	^self keyUp: anEvent!

----- Method: Morph>>handleKeystroke: (in category 'events-processing') -----
handleKeystroke: anEvent 
	"System level event handling."
	
	anEvent wasHandled
		ifTrue: [^ self].
	(self handlesKeyboard: anEvent)
		ifFalse: [^ self].
	anEvent wasHandled: true.
	^ self keyStroke: anEvent!

----- Method: Morph>>handleListenEvent: (in category 'events-processing') -----
handleListenEvent: anEvent
	"Handle the given event. This message is sent if the receiver is a registered listener for the given event."
	^anEvent sentTo: self.!

----- Method: Morph>>handleMouseDown: (in category 'events-processing') -----
handleMouseDown: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	anEvent hand removePendingBalloonFor: self.
	anEvent hand removePendingHaloFor: self.
	anEvent wasHandled: true.

	(anEvent controlKeyPressed
			and: [anEvent blueButtonChanged not
				and: [Preferences cmdGesturesEnabled]])
		ifTrue: [^ self invokeMetaMenu: anEvent].

	"Make me modal during mouse transitions"
	anEvent hand newMouseFocus: self event: anEvent.
	anEvent blueButtonChanged ifTrue:[^self blueButtonDown: anEvent].
	
	"this mouse down could be the start of a gesture, or the end of a gesture focus"
	(self isGestureStart: anEvent)
		ifTrue: [^ self gestureStart: anEvent].

	self mouseDown: anEvent.

	Preferences maintainHalos
		ifFalse:[ anEvent hand removeHaloFromClick: anEvent on: self ].

	(self handlesMouseStillDown: anEvent) ifTrue:[
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue + self mouseStillDownThreshold
			arguments: {anEvent copy resetHandlerFields}
			stepTime: self mouseStillDownStepRate ].
!

----- Method: Morph>>handleMouseEnter: (in category 'events-processing') -----
handleMouseEnter: anEvent
	"System level event handling."
	(anEvent isDraggingEvent) ifTrue:[
		(self handlesMouseOverDragging: anEvent) ifTrue:[
			anEvent wasHandled: true.
			self mouseEnterDragging: anEvent].
		^self].
	self wantsHalo "If receiver wants halo and balloon, trigger balloon after halo"
		ifTrue:[anEvent hand triggerHaloFor: self after: self haloDelayTime]
		ifFalse:[self wantsBalloon
			ifTrue:[anEvent hand triggerBalloonFor: self after: self balloonHelpDelayTime]].
	(self handlesMouseOver: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseEnter: anEvent.
	].!

----- Method: Morph>>handleMouseLeave: (in category 'events-processing') -----
handleMouseLeave: anEvent
	"System level event handling."
	anEvent hand removePendingBalloonFor: self.
	anEvent hand removePendingHaloFor: self.
	anEvent isDraggingEvent ifTrue:[
		(self handlesMouseOverDragging: anEvent) ifTrue:[
			anEvent wasHandled: true.
			self mouseLeaveDragging: anEvent].
		^self].
	(self handlesMouseOver: anEvent) ifTrue:[
		anEvent wasHandled: true.
		self mouseLeave: anEvent.
	].
!

----- Method: Morph>>handleMouseMove: (in category 'events-processing') -----
handleMouseMove: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	"Rules say that by default a morph gets #mouseMove iff
		* the hand is not dragging anything,
			+ and some button is down,
			+ and the receiver is the current mouse focus."
	(anEvent hand hasSubmorphs) ifTrue:[^self].
	(anEvent anyButtonPressed and:[anEvent hand mouseFocus == self]) ifFalse:[^self].
	anEvent wasHandled: true.
	self mouseMove: anEvent.
	(self handlesMouseStillDown: anEvent) ifTrue:[
		"Step at the new location"
		self startStepping: #handleMouseStillDown: 
			at: Time millisecondClockValue
			arguments: {anEvent copy resetHandlerFields}
			stepTime: self mouseStillDownStepRate ].
!

----- Method: Morph>>handleMouseOver: (in category 'events-processing') -----
handleMouseOver: anEvent
	"System level event handling."
	anEvent hand mouseFocus == self ifTrue:[
		"Got this directly through #handleFocusEvent: so check explicitly"
		(self containsPoint: anEvent position event: anEvent) ifFalse:[^self]].
	anEvent hand noticeMouseOver: self event: anEvent!

----- Method: Morph>>handleMouseStillDown: (in category 'events-processing') -----
handleMouseStillDown: anEvent
	"Called from the stepping mechanism for morphs wanting continuously repeated 'yes the mouse is still down, yes it is still down, yes it has not changed yet, no the mouse is still not up, yes the button is down' etc messages"
	(anEvent hand mouseFocus == self) 
		ifFalse:[^self stopSteppingSelector: #handleMouseStillDown:].
	self mouseStillDown: anEvent.
!

----- Method: Morph>>handleMouseUp: (in category 'events-processing') -----
handleMouseUp: anEvent
	"System level event handling."
	anEvent wasHandled ifTrue:[^self]. "not interested"
	anEvent hand mouseFocus == self ifFalse:[^self]. "Not interested in other parties"
	anEvent hand releaseMouseFocus: self.
	anEvent wasHandled: true.
	anEvent blueButtonChanged
		ifTrue:[self blueButtonUp: anEvent]
		ifFalse:[self mouseUp: anEvent.
				self stopSteppingSelector: #handleMouseStillDown:].!

----- Method: Morph>>handleUnknownEvent: (in category 'events-processing') -----
handleUnknownEvent: anEvent
	"An event of an unknown type was sent to the receiver. What shall we do?!!"
	Beeper beep. 
	anEvent printString displayAt: 0 at 0.
	anEvent wasHandled: true.!

----- Method: Morph>>handleWindowEvent: (in category 'events-processing') -----
handleWindowEvent: anEvent
	"Handle an event concerning our host window"
	anEvent wasHandled ifTrue:[^self]. "not interested"
	(self wantsWindowEvent: anEvent) ifFalse:[^self].
	anEvent wasHandled: true.
	self windowEvent: anEvent.
!

----- Method: Morph>>handlerForBlueButtonDown: (in category 'meta-actions') -----
handlerForBlueButtonDown: anEvent
	"Return the (prospective) handler for a mouse down event. The handler is temporarily installed and can be used for morphs further down the hierarchy to negotiate whether the inner or the outer morph should finally handle the event.
	Note: Halos handle blue button events themselves so we will only be asked if there is currently no halo on top of us."
	self wantsHaloFromClick ifFalse:[^nil].
	anEvent handler ifNil:[^self].
	anEvent handler isPlayfieldLike ifTrue:[^self]. "by default exclude playfields"
	(anEvent shiftPressed)
		ifFalse:[^nil] "let outer guy have it"
		ifTrue:[^self] "let me have it"
!

----- Method: Morph>>handlerForMetaMenu: (in category 'meta-actions') -----
handlerForMetaMenu: evt
	"Return the prospective handler for invoking the meta menu. By default, the top-most morph in the innermost world gets this menu"
	self isWorldMorph ifTrue:[^self].
	evt handler ifNotNil:[evt handler isWorldMorph ifTrue:[^self]].
	^nil!

----- Method: Morph>>handlerForMouseDown: (in category 'event handling-override') -----
handlerForMouseDown: anEvent 
	"Return the (prospective) handler for a mouse down event. The handler is temporarily 
	installed and can be used for morphs further down the hierarchy to negotiate whether 
	the inner or the outer morph should finally handle the event."

	anEvent blueButtonPressed
		ifTrue: [^ self handlerForBlueButtonDown: anEvent].
	anEvent yellowButtonPressed
		ifTrue: [^ self handlerForYellowButtonDown: anEvent].
	anEvent controlKeyPressed
		ifTrue: [^ self handlerForMetaMenu: anEvent].
	(self handlesMouseDown: anEvent)
		ifFalse: [^ nil].	"not interested"

	anEvent handler
		ifNil: [^ self ].	"Same priority but I am innermost"

	"Nobody else was interested"
	^self mouseDownPriority >= anEvent handler mouseDownPriority
		ifTrue: [ self]
		ifFalse: [ nil]!

----- Method: Morph>>handlerForYellowButtonDown: (in category 'event handling') -----
handlerForYellowButtonDown: anEvent 
	"Return the (prospective) handler for a mouse down event with the yellow button pressed.
	The 	handler is temporarily installed and can be used for morphs further 
	down the hierarchy to negotiate whether the inner or the outer 
	morph should finally handle the event."

	(self hasYellowButtonMenu or: [ self handlesMouseDown: anEvent ])
		ifFalse: [ ^ nil].	"Not interested."

	anEvent handler
		ifNil: [^ self].	"Nobody else was interested"

	"Same priority but I am innermost."
	^ self mouseDownPriority >= anEvent handler mouseDownPriority
		ifFalse: [nil ]
		ifTrue: [self]!

----- Method: Morph>>handlesKeyboard: (in category 'event handling') -----
handlesKeyboard: evt
	"Return true if the receiver wishes to handle the given keyboard event"
	self eventHandler ifNotNil: [^ self eventHandler handlesKeyboard: evt].
	^ false
!

----- Method: Morph>>handlesMouseDown: (in category 'event handling') -----
handlesMouseDown: evt
	"Do I want to receive mouseDown events (mouseDown:, mouseMove:, mouseUp:)?"
	"NOTE: The default response is false, except if you have added sensitivity to mouseDown events using the on:send:to: mechanism.  Subclasses that implement these messages directly should override this one to return true." 

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseDown: evt].
	^ false!

----- Method: Morph>>handlesMouseOver: (in category 'event handling') -----
handlesMouseOver: evt
	"Do I want to receive mouseEnter: and mouseLeave: when the button is up and the hand is empty?  The default response is false, except if you have added sensitivity to mouseEnter: or mouseLeave:, using the on:send:to: mechanism." 

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseOver: evt].
	^ false!

----- Method: Morph>>handlesMouseOverDragging: (in category 'event handling') -----
handlesMouseOverDragging: evt
	"Return true if I want to receive mouseEnterDragging: and mouseLeaveDragging: when the hand drags something over me (button up or button down), or when the mouse button is down but there is no mouseDown recipient.  The default response is false, except if you have added sensitivity to mouseEnterLaden: or mouseLeaveLaden:, using the on:send:to: mechanism."
	"NOTE:  If the hand state matters in these cases, it may be tested by constructs such as
		event anyButtonPressed
		event hand hasSubmorphs"

	self eventHandler ifNotNil: [^ self eventHandler handlesMouseOverDragging: evt].
	^ false!

----- Method: Morph>>handlesMouseStillDown: (in category 'event handling') -----
handlesMouseStillDown: evt
	"Return true if the receiver wants to get repeated #mouseStillDown: messages between #mouseDown: and #mouseUp"
	self eventHandler ifNotNil: [^ self eventHandler handlesMouseStillDown: evt].
	^ false
!

----- Method: Morph>>hasClipLayoutCellsString (in category 'layout-menu') -----
hasClipLayoutCellsString
	^ (self clipLayoutCells
		ifTrue: ['<on>']
		ifFalse: ['<off>']), 'clip to cell size' translated!

----- Method: Morph>>hasClipSubmorphsString (in category 'drawing') -----
hasClipSubmorphsString
	"Answer a string that represents the clip-submophs checkbox"
	^ (self clipSubmorphs
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'provide clipping' translated!

----- Method: Morph>>hasDirectionHandlesString (in category 'menus') -----
hasDirectionHandlesString
	^ (self wantsDirectionHandles
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'direction handles' translated!

----- Method: Morph>>hasDisableTableLayoutString (in category 'layout-menu') -----
hasDisableTableLayoutString
	^ (self disableTableLayout
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'disable layout in tables' translated!

----- Method: Morph>>hasDocumentAnchorString (in category 'text-anchor') -----
hasDocumentAnchorString
	^ (self textAnchorType == #document
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'Document' translated!

----- Method: Morph>>hasDragAndDropEnabledString (in category 'menus') -----
hasDragAndDropEnabledString
	"Answer a string to characterize the drag & drop status of the  
	receiver"
	^ (self dragNDropEnabled
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'accept drops' translated!

----- Method: Morph>>hasDropShadow (in category 'drop shadows') -----
hasDropShadow
	"answer whether the receiver has DropShadow"
	^ self
		valueOfProperty: #hasDropShadow
		ifAbsent: [false]!

----- Method: Morph>>hasDropShadow: (in category 'drop shadows') -----
hasDropShadow: aBool
	aBool
		ifTrue:[self setProperty: #hasDropShadow toValue: true]
		ifFalse:[self removeProperty: #hasDropShadow]!

----- Method: Morph>>hasDropShadowString (in category 'drop shadows') -----
hasDropShadowString
	^ (self hasDropShadow
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'show shadow' translated!

----- Method: Morph>>hasExtension (in category 'accessing - extension') -----
hasExtension
	"answer whether the receiver has extention"
	^ extension notNil!

----- Method: Morph>>hasFocus (in category 'event handling') -----
hasFocus
	^ false!

----- Method: Morph>>hasHalo (in category 'halos and balloon help') -----
hasHalo
	^self hasProperty: #hasHalo.!

----- Method: Morph>>hasHalo: (in category 'halos and balloon help') -----
hasHalo: aBool
	aBool
		ifTrue:[self setProperty: #hasHalo toValue: true]
		ifFalse:[self removeProperty: #hasHalo]!

----- Method: Morph>>hasInlineAnchorString (in category 'text-anchor') -----
hasInlineAnchorString
	^ (self textAnchorType == #inline
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'Inline' translated!

----- Method: Morph>>hasNoLayoutString (in category 'layout-menu') -----
hasNoLayoutString
	^ (self layoutPolicy isNil
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'no layout' translated!

----- Method: Morph>>hasOwner: (in category 'structure') -----
hasOwner: aMorph
	"Return true if the receiver has aMorph in its owner chain"
	aMorph ifNil:[^true].
	self allOwnersDo:[:m| m = aMorph ifTrue:[^true]].
	^false!

----- Method: Morph>>hasParagraphAnchorString (in category 'text-anchor') -----
hasParagraphAnchorString
	^ (self textAnchorType == #paragraph
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'Paragraph' translated!

----- Method: Morph>>hasProperty: (in category 'accessing - properties') -----
hasProperty: aSymbol 
	"Answer whether the receiver has the property named aSymbol"
	extension ifNil: [^ false].
	^extension hasProperty: aSymbol!

----- Method: Morph>>hasProportionalLayoutString (in category 'layout-menu') -----
hasProportionalLayoutString
	| layout |
	^ (((layout := self layoutPolicy) notNil
			and: [layout isProportionalLayout])
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'proportional layout' translated!

----- Method: Morph>>hasReverseCellsString (in category 'layout-menu') -----
hasReverseCellsString
	^ (self reverseTableCells
		ifTrue: ['<on>']
		ifFalse: ['<off>']), 'reverse table cells' translated!

----- Method: Morph>>hasRolloverBorder (in category 'drop shadows') -----
hasRolloverBorder
	"answer whether the receiver has RolloverBorder"
	^ self
		valueOfProperty: #hasRolloverBorder
		ifAbsent: [false]!

----- Method: Morph>>hasRolloverBorder: (in category 'drop shadows') -----
hasRolloverBorder: aBool
	aBool
		ifTrue:[self setProperty: #hasRolloverBorder toValue: true]
		ifFalse:[self removeProperty: #hasRolloverBorder]!

----- Method: Morph>>hasRubberBandCellsString (in category 'layout-menu') -----
hasRubberBandCellsString
	^ (self rubberBandCells
		ifTrue: ['<on>']
		ifFalse: ['<off>']), 'rubber band cells' translated!

----- Method: Morph>>hasSubmorphWithProperty: (in category 'submorphs-accessing') -----
hasSubmorphWithProperty: aSymbol
	submorphs detect: [:m | m hasProperty: aSymbol] ifNone: [^ false].
	^ true!

----- Method: Morph>>hasSubmorphs (in category 'submorphs-accessing') -----
hasSubmorphs
	^submorphs notEmpty!

----- Method: Morph>>hasTableLayoutString (in category 'layout-menu') -----
hasTableLayoutString
	| layout |
	^ (((layout := self layoutPolicy) notNil
			and: [layout isTableLayout])
		ifTrue: ['<on>']
		ifFalse: ['<off>'])
		, 'table layout' translated!

----- Method: Morph>>hasTranslucentColor (in category 'accessing') -----
hasTranslucentColor
	"Answer true if this any of this morph is translucent but not transparent."

	^ color isColor and: [color isTranslucentColor]
!

----- Method: Morph>>hasYellowButtonMenu (in category 'menu') -----
hasYellowButtonMenu
	"Answer true if I have any items at all for a context (yellow  
	button) menu."
	^ self wantsYellowButtonMenu
			or: [self models anySatisfy: [:each | each hasModelYellowButtonMenuItems]]!

----- Method: Morph>>heading (in category 'geometry eToy') -----
heading
	"Return the receiver's heading (in eToy terms)"
	owner ifNil: [^ self forwardDirection].
	^ self forwardDirection + owner degreesOfFlex!

----- Method: Morph>>heading: (in category 'geometry eToy') -----
heading: newHeading
	"Set the receiver's heading (in eToy terms)"
	self isFlexed ifFalse:[self addFlexShell].
	owner rotationDegrees: (newHeading - self forwardDirection).!

----- Method: Morph>>height (in category 'geometry') -----
height

	^ bounds height!

----- Method: Morph>>height: (in category 'geometry') -----
height: aNumber
	" Set my height; my position (top-left corner) and width will remain the same "

	self extent: self width at aNumber asInteger.
!

----- Method: Morph>>helpButton (in category 'menus') -----
helpButton
	"Answer a button whose action would be to put up help concerning the receiver"

	| aButton |
	aButton := SimpleButtonMorph new.
	aButton
		target: self;
		color: ColorTheme current helpColor;
		borderColor: ColorTheme current helpColor muchDarker;
		borderWidth: 1;
		label: '?' translated font: Preferences standardButtonFont;
		actionSelector: #presentHelp;
		setBalloonText: 'click here for help' translated.
	^ aButton!

----- Method: Morph>>hide (in category 'drawing') -----
hide
	owner ifNil: [^ self].
	self visible ifTrue: [self visible: false.  self changed]!

----- Method: Morph>>highlight (in category 'accessing') -----
highlight
	"The receiver is being asked to appear in a highlighted state.  Mostly used for textual morphs"
	self color: self highlightColor!

----- Method: Morph>>highlightColor (in category 'accessing') -----
highlightColor
	
	| val |
	^ (val := self valueOfProperty: #highlightColor)
		ifNotNil:
			[val ifNil: [self error: 'nil highlightColor']]
		ifNil:
			[owner ifNil: [self color] ifNotNil: [owner highlightColor]]!

----- Method: Morph>>highlightColor: (in category 'accessing') -----
highlightColor: aColor
	self setProperty: #highlightColor toValue: aColor!

----- Method: Morph>>highlightForDrop (in category 'dropping/grabbing') -----
highlightForDrop
	self highlightForDrop: true!

----- Method: Morph>>highlightForDrop: (in category 'dropping/grabbing') -----
highlightForDrop: aBoolean
	self setProperty: #highlightedForDrop toValue: aBoolean.
	self changed!

----- Method: Morph>>highlightForMouseDown (in category 'drawing') -----
highlightForMouseDown
	self highlightForMouseDown: true!

----- Method: Morph>>highlightForMouseDown: (in category 'drawing') -----
highlightForMouseDown: aBoolean
	aBoolean 
		ifTrue:[self setProperty: #highlightedForMouseDown toValue: aBoolean]
		ifFalse:[self removeProperty: #highlightedForMouseDown. self resetExtension].
	self changed!

----- Method: Morph>>highlightedForDrop (in category 'dropping/grabbing') -----
highlightedForDrop
	^(self valueOfProperty: #highlightedForDrop) == true!

----- Method: Morph>>highlightedForMouseDown (in category 'drawing') -----
highlightedForMouseDown
	^(self valueOfProperty: #highlightedForMouseDown) == true!

----- Method: Morph>>icon (in category 'thumbnail') -----
icon
	"Answer a form with an icon to represent the receiver"
	^ self valueOfProperty: #icon!

----- Method: Morph>>iconOrThumbnail (in category 'thumbnail') -----
iconOrThumbnail
	"Answer an appropiate form to represent the receiver"

	^ self icon
		ifNil: [ | maxExtent fb |maxExtent := 320 @ 240.
			fb := self fullBounds.
			fb area <= (maxExtent x * maxExtent y)
				ifTrue: [self imageForm]
				ifFalse: [self imageFormForRectangle: (fb topLeft extent: maxExtent)]
		]
!

----- Method: Morph>>iconOrThumbnailOfSize: (in category 'thumbnail') -----
iconOrThumbnailOfSize: aNumberOrPoint 
	"Answer an appropiate form to represent the receiver"

	^ self iconOrThumbnail scaledIntoFormOfSize: aNumberOrPoint
!

----- Method: Morph>>imageForm (in category 'drawing') -----
imageForm

	^ self imageFormForRectangle: self fullBounds
!

----- Method: Morph>>imageForm:backgroundColor:forRectangle: (in category 'drawing') -----
imageForm: depth backgroundColor: aColor forRectangle: rect
	| canvas |
	canvas := Display defaultCanvasClass extent: rect extent depth: depth.
	canvas translateBy: rect topLeft negated
		during:[:tempCanvas| 
			tempCanvas fillRectangle: rect color: aColor.
			tempCanvas fullDrawMorph: self].
	^ canvas form offset: rect topLeft!

----- Method: Morph>>imageForm:forRectangle: (in category 'drawing') -----
imageForm: depth forRectangle: rect
	| canvas |
	canvas := Display defaultCanvasClass extent: rect extent depth: depth.
	canvas translateBy: rect topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: rect topLeft!

----- Method: Morph>>imageFormDepth: (in category 'drawing') -----
imageFormDepth: depth

	^ self imageForm: depth forRectangle: self fullBounds
!

----- Method: Morph>>imageFormForRectangle: (in category 'drawing') -----
imageFormForRectangle: rect

	^ self imageForm: Display depth forRectangle: rect
!

----- Method: Morph>>imageFormWithout:andStopThere: (in category 'drawing') -----
imageFormWithout: stopMorph andStopThere: stopThere
	"Like imageForm, except it does not display stopMorph,
	and it will not display anything above it if stopThere is true.
	Returns a pair of the imageForm and a boolean that is true
		if it has hit stopMorph, and display should stop."
	| canvas rect |
	rect := self fullBounds.
	canvas := ColorPatchCanvas extent: rect extent depth: Display depth.
	canvas stopMorph: stopMorph.
	canvas doStop: stopThere.
	canvas translateBy: rect topLeft negated during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ Array with: (canvas form offset: rect topLeft)
			with: canvas foundMorph!

----- Method: Morph>>inAScrollPane (in category 'initialization') -----
inAScrollPane
	"Answer a 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!

----- Method: Morph>>inATwoWayScrollPane (in category 'initialization') -----
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 := TwoWayScrollPane 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!

----- Method: Morph>>inPartsBin (in category 'parts bin') -----
inPartsBin

	self isPartsDonor ifTrue: [^ true].
	self allOwnersDo: [:m | m isPartsBin ifTrue: [^ true]].
	^ false
!

----- Method: Morph>>indexOfMorphAbove: (in category 'submorphs-accessing') -----
indexOfMorphAbove: aPoint
	"Return index of lowest morph whose bottom is above aPoint.
	Will return 0 if the first morph is not above aPoint."

	submorphs withIndexDo: [:mm :ii | 
		mm fullBounds bottom >= aPoint y ifTrue: [^ ii - 1]].
	^ submorphs size!

----- Method: Morph>>indicateAllSiblings (in category 'meta-actions') -----
indicateAllSiblings
	"Indicate all the receiver and all its siblings by flashing momentarily."

	| aPlayer allBoxes |
	(aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [^ self "error: 'not uniclass'"].
	allBoxes := aPlayer class allInstances
		select: [:m | m costume world == ActiveWorld]
		thenCollect: [:m | m costume boundsInWorld].

	5 timesRepeat:
		[Display flashAll: allBoxes andWait: 120]!

----- Method: Morph>>initString (in category 'printing') -----
initString

	^ String streamContents: [:s | self fullPrintOn: s]!

----- Method: Morph>>initialExtent (in category 'user interface') -----
initialExtent
	| ext |
	(ext := self valueOfProperty: #initialExtent)
		ifNotNil:
			[^ ext].
	^ super initialExtent!

----- Method: Morph>>initialize (in category 'initialization') -----
initialize
	"initialize the state of the receiver"
owner := nil.
	submorphs := EmptyArray.
	bounds := self defaultBounds.
	
	color := self defaultColor!

----- Method: Morph>>initializeExtension (in category 'accessing - extension') -----
initializeExtension
	"private - initializes the receiver's extension"
	extension := MorphExtension new!

----- Method: Morph>>initializeToStandAlone (in category 'parts bin') -----
initializeToStandAlone
	"Set up the receiver, created by a #basicNew and now ready to be initialized, as a fully-formed morph suitable for providing a graphic for a parts bin surrogate, and, when such a parts-bin surrogate is clicked on, for attaching to the hand as a viable stand-alone morph.  Because of historical precedent, #initialize has been expected to handle this burden, though a great number of morphs actually cannot stand alone.  In any case, by default we call the historical #initialize, though unhappily, so that all existing morphs will work no worse than before when using this protocol."

	self initialize!

----- Method: Morph>>innerBounds (in category 'geometry') -----
innerBounds
	"Return the inner rectangle enclosed by the bounds of this morph excluding the space taken by its borders. For an unbordered morph, this is just its bounds."

	^ self bounds insetBy: self borderWidth!

----- Method: Morph>>innocuousName (in category 'naming') -----
innocuousName
	"Choose an innocuous name for the receiver -- one that does not end in the word Morph"

	| className allKnownNames |
	className := self defaultNameStemForInstances.
	(className size > 5 and: [className endsWith: 'Morph'])
		ifTrue: [className := className copyFrom: 1 to: className size - 5].
	className := className asString translated.
	allKnownNames := self world ifNil: [OrderedCollection new] ifNotNil: [self world allKnownNames].
	^ Utilities keyLike: className asString satisfying:
		[:aName | (allKnownNames includes: aName) not]!

----- Method: Morph>>insetColor (in category 'accessing') -----
insetColor
	owner ifNil:[^self color].
	^ self colorForInsets!

----- Method: Morph>>inspectArgumentsPlayerInMorphic: (in category 'debug and other') -----
inspectArgumentsPlayerInMorphic: evt
	evt hand attachMorph: ((Inspector openOn: self player) extent: 300 at 200)!

----- Method: Morph>>inspectAt:event: (in category 'meta-actions') -----
inspectAt: aPoint event: evt
	| morphs target |
	morphs := self morphsAt: aPoint.
	(morphs includes: self) ifFalse:[morphs := morphs copyWith: self].
	target := UIManager default
		chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
		values: morphs
		title:  ('inspect whom?
(deepest at top)').
	target ifNil:[^self].
	target inspectInMorphic: evt!

----- Method: Morph>>inspectInMorphic (in category 'menus') -----
inspectInMorphic
	self currentHand attachMorph: ((ToolSet inspect: self) extent: 300 at 200)!

----- Method: Morph>>inspectInMorphic: (in category 'menus') -----
inspectInMorphic: evt
	evt hand attachMorph: ((ToolSet inspect: self) extent: 300 at 200)!

----- Method: Morph>>inspectOwnerChain (in category 'debug and other') -----
inspectOwnerChain
	self ownerChain inspectWithLabel: 'Owner chain for ', self printString!

----- Method: Morph>>installModelIn: (in category 'debug and other') -----
installModelIn: ignored
	"Simple morphs have no model"
	"See MorphicApp for other behavior"!

----- Method: Morph>>intersects: (in category 'geometry') -----
intersects: aRectangle
	"Answer whether aRectangle, which is in World coordinates, intersects me."

	^self fullBoundsInWorld intersects: aRectangle!

----- Method: Morph>>intoWorld: (in category 'initialization') -----
intoWorld: aWorld
	"The receiver has just appeared in a new world. Note:
		* aWorld can be nil (due to optimizations in other places)
		* owner is already set
		* owner's submorphs may not include receiver yet.
	Important: Keep this method fast - it is run whenever morphs are added."
	aWorld ifNil:[^self].
	self wantsSteps ifTrue:[aWorld startStepping: self].
	self submorphsDo:[:m| m intoWorld: aWorld].
!

----- Method: Morph>>invalidRect: (in category 'change reporting') -----
invalidRect: damageRect
	^self invalidRect: damageRect from: self!

----- Method: Morph>>invalidRect:from: (in category 'change reporting') -----
invalidRect: aRectangle from: aMorph
	| damageRect |
	aRectangle hasPositiveExtent ifFalse: [ ^self ].
	damageRect := aRectangle.
	aMorph == self ifFalse:[
		"Clip to receiver's clipping bounds if the damage came from a child"
		self clipSubmorphs 
			ifTrue:[damageRect := aRectangle intersect: self clippingBounds]].
	owner ifNotNil: [owner invalidRect: damageRect from: self].!

----- Method: Morph>>invokeMetaMenu: (in category 'meta-actions') -----
invokeMetaMenu: evt
	| menu |
	menu := self buildMetaMenu: evt.
	menu addTitle: self externalName.
	self world ifNotNil: [
		menu popUpEvent: evt in: self world
	]!

----- Method: Morph>>invokeMetaMenuAt:event: (in category 'meta-actions') -----
invokeMetaMenuAt: aPoint event: evt
	| morphs target |
	morphs := self morphsAt: aPoint.
	(morphs includes: self) ifFalse:[morphs := morphs copyWith: self].
	morphs size = 1 ifTrue:[morphs first invokeMetaMenu: evt].
	target := UIManager default
		chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
		values: morphs.
	target ifNil:[^self].
	target invokeMetaMenu: evt!

----- Method: Morph>>isAViewer (in category 'e-toy support') -----
isAViewer
	^ false!

----- Method: Morph>>isAlignmentMorph (in category 'classification') -----
isAlignmentMorph

	^ false!

----- Method: Morph>>isBalloonHelp (in category 'classification') -----
isBalloonHelp
	^false!

----- Method: Morph>>isCandidateForAutomaticViewing (in category 'e-toy support') -----
isCandidateForAutomaticViewing
	^ true!

----- Method: Morph>>isCompoundTileMorph (in category 'classification') -----
isCompoundTileMorph
	^false!

----- Method: Morph>>isDockingBar (in category 'testing') -----
isDockingBar
	"Return true if the receiver is a docking bar"
	^ false!

----- Method: Morph>>isEtoyReadout (in category 'latter day support') -----
isEtoyReadout
	"Answer whether the receiver can serve as an etoy readout"

	^ false!

----- Method: Morph>>isFlap (in category 'accessing') -----
isFlap
	"Answer whether the receiver claims to be a flap"

	^ self hasProperty: #flap!

----- Method: Morph>>isFlapOrTab (in category 'classification') -----
isFlapOrTab
	^self isFlap or:[self isFlapTab]!

----- Method: Morph>>isFlapTab (in category 'classification') -----
isFlapTab
	^false!

----- Method: Morph>>isFlexMorph (in category 'classification') -----
isFlexMorph

	^ false
!

----- Method: Morph>>isFlexed (in category 'testing') -----
isFlexed
	"Return true if the receiver is currently flexed"
	owner ifNil:[^false].
	^owner isFlexMorph!

----- Method: Morph>>isFullOnScreen (in category 'testing') -----
isFullOnScreen
	"Answer if the receiver is full contained in the owner visible  
	area."
	owner isInMemory
		ifFalse: [^ true].
	owner isNil
		ifTrue: [^ true].
	self visible
		ifFalse: [^ true].
	^ owner clearArea containsRect: self fullBounds!

----- Method: Morph>>isGestureStart: (in category 'geniestubs') -----
isGestureStart: anEvent
	"This mouse down could be the start of a gesture, or the end of a gesture focus"

	anEvent hand isGenieEnabled
		ifFalse: [ ^false ].

	(self allowsGestureStart: anEvent)
		ifTrue: [^ true ].		"could be the start of a gesture"

	"otherwise, check for whether it's time to disable the Genie auto-focus"
	(anEvent hand isGenieFocused
		and: [anEvent whichButton ~= anEvent hand focusStartEvent whichButton])
			ifTrue: [anEvent hand disableGenieFocus].

	^false!

----- Method: Morph>>isHandMorph (in category 'classification') -----
isHandMorph

	^ false!

----- Method: Morph>>isInDockingBar (in category 'structure') -----
isInDockingBar
	"answer if the receiver is in a menu bar"
	^ (owner notNil) and: [owner isDockingBar]!

----- Method: Morph>>isInSystemWindow (in category 'structure') -----
isInSystemWindow
	"answer if the receiver is in a system window"
	^ owner isMorph and:[owner isSystemWindow or:[owner isInSystemWindow]]!

----- Method: Morph>>isInWorld (in category 'structure') -----
isInWorld
	"Return true if this morph is in a world."

	^self world notNil!

----- Method: Morph>>isKedamaMorph (in category 'classification') -----
isKedamaMorph
	^false!

----- Method: Morph>>isLikelyRecipientForMouseOverHalos (in category 'halos and balloon help') -----
isLikelyRecipientForMouseOverHalos
	^self player notNil!

----- Method: Morph>>isLineMorph (in category 'testing') -----
isLineMorph
	^false!

----- Method: Morph>>isLocked (in category 'accessing') -----
isLocked
	"answer whether the receiver is Locked"
	extension ifNil: [^ false].
	^ extension locked!

----- Method: Morph>>isModalShell (in category 'classification') -----
isModalShell
	^false!

----- Method: Morph>>isMorph (in category 'testing') -----
isMorph

	^ true!

----- Method: Morph>>isNumericReadoutTile (in category 'classification') -----
isNumericReadoutTile
	^false!

----- Method: Morph>>isPartsBin (in category 'parts bin') -----
isPartsBin
	^ false!

----- Method: Morph>>isPartsDonor (in category 'parts bin') -----
isPartsDonor
	"answer whether the receiver is PartsDonor"
	extension ifNil: [^ false].
	^ extension isPartsDonor!

----- Method: Morph>>isPartsDonor: (in category 'parts bin') -----
isPartsDonor: aBoolean 
	"change the receiver's isPartDonor property"
	(extension isNil and: [aBoolean not]) ifTrue: [^ self].
	self assureExtension isPartsDonor: aBoolean!

----- Method: Morph>>isPhraseTileMorph (in category 'classification') -----
isPhraseTileMorph
	^false!

----- Method: Morph>>isPlayfieldLike (in category 'classification') -----
isPlayfieldLike
	^ false!

----- Method: Morph>>isRenderer (in category 'classification') -----
isRenderer
	"A *renderer* morph transforms the appearance of its submorph in some manner. For example, it might supply a drop shadow or scale and rotate the morph it encases. Answer true if this morph acts as a renderer. This default implementation returns false."
	"Details: A renderer is assumed to have a single submorph. Renderers may be nested to concatenate their transformations. It is useful to be able to find the outer-most renderer. This can be done by ascending the owner chain from the rendered morph. To find the morph being rendered, one can descend through the (singleton) submorph lists of the renderer chain until a non-renderer is encountered."

	^ false
!

----- Method: Morph>>isSafeToServe (in category 'testing') -----
isSafeToServe
	"Return true if it is safe to serve this Morph using Nebraska." 
	^true!

----- Method: Morph>>isShared (in category 'accessing') -----
isShared
	"Answer whether the receiver has the #shared property.  This property allows it to be treated as a 'background' item"

	^ self hasProperty: #shared!

----- Method: Morph>>isSketchMorph (in category 'testing') -----
isSketchMorph
	^self class isSketchMorphClass!

----- Method: Morph>>isSoundTile (in category 'classification') -----
isSoundTile
	^false!

----- Method: Morph>>isStandardViewer (in category 'classification') -----
isStandardViewer
	^false!

----- Method: Morph>>isStepping (in category 'stepping and presenter') -----
isStepping
	"Return true if the receiver is currently stepping in its world"
	| aWorld |
	^ (aWorld := self world)
		ifNil:		[false]
		ifNotNil:	[aWorld isStepping: self]!

----- Method: Morph>>isSteppingSelector: (in category 'stepping and presenter') -----
isSteppingSelector: aSelector
	"Return true if the receiver is currently stepping in its world"
	| aWorld |
	^ (aWorld := self world)
		ifNil:		[false]
		ifNotNil:	[aWorld isStepping: self selector: aSelector]!

----- Method: Morph>>isSticky (in category 'accessing') -----
isSticky
	"answer whether the receiver is Sticky"
	extension ifNil: [^ false].
	^ extension sticky!

----- Method: Morph>>isStickySketchMorph (in category 'classification') -----
isStickySketchMorph
	^false!

----- Method: Morph>>isSyntaxMorph (in category 'classification') -----
isSyntaxMorph
	^false!

----- Method: Morph>>isTextMorph (in category 'classification') -----
isTextMorph
	^false!

----- Method: Morph>>isTileEditor (in category 'e-toy support') -----
isTileEditor
	"No, I'm not"
	^false!

----- Method: Morph>>isTileMorph (in category 'classification') -----
isTileMorph
	^false!

----- Method: Morph>>isTilePadMorph (in category 'classification') -----
isTilePadMorph
	^false!

----- Method: Morph>>isViewer (in category 'classification') -----
isViewer
	^false!

----- Method: Morph>>isWorldMorph (in category 'classification') -----
isWorldMorph

	^ false!

----- Method: Morph>>isWorldOrHandMorph (in category 'classification') -----
isWorldOrHandMorph

	^ self isWorldMorph or: [self isHandMorph]!

----- Method: Morph>>justDroppedInto:event: (in category 'dropping/grabbing') -----
justDroppedInto: aMorph event: anEvent
	"This message is sent to a dropped morph after it has been dropped on -- and been accepted by -- a drop-sensitive morph"

	| aWindow partsBinCase cmd |
	(self formerOwner notNil and: [self formerOwner ~~ aMorph])
		ifTrue: [self removeHalo].
	self formerOwner: nil.
	self formerPosition: nil.
	cmd := self valueOfProperty: #undoGrabCommand.
	cmd ifNotNil:[aMorph rememberCommand: cmd.
				self removeProperty: #undoGrabCommand].
	(partsBinCase := aMorph isPartsBin) ifFalse:
		[self isPartsDonor: false].
	(aWindow := aMorph ownerThatIsA: SystemWindow) ifNotNil:
		[aWindow isActive ifFalse:
			[aWindow activate]].
	(self isInWorld and: [partsBinCase not]) ifTrue:
		[self world startSteppingSubmorphsOf: self].
	"Note an unhappy inefficiency here:  the startStepping... call will often have already been called in the sequence leading up to entry to this method, but unfortunately the isPartsDonor: call often will not have already happened, with the result that the startStepping... call will not have resulted in the startage of the steppage."

	"An object launched by certain parts-launcher mechanisms should end up fully visible..."
	(self hasProperty: #beFullyVisibleAfterDrop) ifTrue:
		[aMorph == ActiveWorld ifTrue:
			[self goHome].
		self removeProperty: #beFullyVisibleAfterDrop].
!

----- Method: Morph>>justGrabbedFrom: (in category 'dropping/grabbing') -----
justGrabbedFrom: formerOwner
	"The receiver was just grabbed from its former owner and is now attached to the hand. By default, we pass this message on if we're a renderer."
	(self isRenderer and:[self hasSubmorphs]) 
		ifTrue:[self firstSubmorph justGrabbedFrom: formerOwner].!

----- Method: Morph>>keepsTransform (in category 'rotate scale and flex') -----
keepsTransform
	"Return true if the receiver will keep it's transform while being grabbed by a hand."
	^false!

----- Method: Morph>>keyDown: (in category 'event handling') -----
keyDown: anEvent
	"Handle a key down event. The default response is to do nothing."!

----- Method: Morph>>keyStroke: (in category 'event handling') -----
keyStroke: anEvent
	"Handle a keystroke event.  The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler keyStroke: anEvent fromMorph: self].
!

----- Method: Morph>>keyUp: (in category 'event handling') -----
keyUp: anEvent
	"Handle a key up event. The default response is to do nothing."!

----- Method: Morph>>keyboardFocusChange: (in category 'event handling') -----
keyboardFocusChange: aBoolean
	"The message is sent to a morph when its keyboard focus change. The given argument indicates that the receiver is gaining keyboard focus (versus losing) the keyboard focus. Morphs that accept keystrokes should change their appearance in some way when they are the current keyboard focus. This default implementation does nothing."!

----- Method: Morph>>knownName (in category 'testing') -----
knownName
	"answer a name by which the receiver is known, or nil if none"
	^ extension ifNotNil: [extension externalName]!

----- Method: Morph>>lastSubmorph (in category 'submorphs-accessing') -----
lastSubmorph
	^submorphs last!

----- Method: Morph>>layoutBounds (in category 'layout') -----
layoutBounds
	"Return the bounds for laying out children of the receiver"
	| inset box |
	inset := self layoutInset.
	box := self innerBounds.
	inset isZero ifTrue:[^box].
	^box insetBy: inset.!

----- Method: Morph>>layoutBounds: (in category 'layout') -----
layoutBounds: aRectangle
	"Set the bounds for laying out children of the receiver.
	Note: written so that #layoutBounds can be changed without touching this method"
	| outer inner |
	outer := self bounds.
	inner := self layoutBounds.
	bounds := aRectangle origin + (outer origin - inner origin) corner:
				aRectangle corner + (outer corner - inner corner).!

----- Method: Morph>>layoutChanged (in category 'layout') -----
layoutChanged
	| layout |
	fullBounds ifNil:[^self]. "layout will be recomputed so don't bother"
	fullBounds := nil.
	layout := self layoutPolicy.
	layout ifNotNil:[layout flushLayoutCache].
	owner ifNotNil: [owner layoutChanged].
	"note: does not send #ownerChanged here - we'll do this when computing the new layout"!

----- Method: Morph>>layoutFrame (in category 'layout-properties') -----
layoutFrame
	"Layout specific. Return the layout frame describing where the  
	receiver should appear in a proportional layout"
	^ extension ifNotNil: [extension layoutFrame]!

----- Method: Morph>>layoutFrame: (in category 'layout-properties') -----
layoutFrame: aLayoutFrame
	"Layout specific. Return the layout frame describing where the receiver should appear in a proportional layout"
	self layoutFrame == aLayoutFrame ifTrue:[^self].
	self assureExtension layoutFrame: aLayoutFrame.
	self layoutChanged.!

----- Method: Morph>>layoutInBounds: (in category 'layout') -----
layoutInBounds: cellBounds
	"Layout specific. Apply the given bounds to the receiver after being layed out in its owner."
	| box aSymbol delta |
	fullBounds ifNil:["We are getting new bounds here but we haven't computed the receiver's layout yet. Although the receiver has reported its minimal size before the actual size it has may differ from what would be after the layout. Normally, this isn't a real problem, but if we have #shrinkWrap constraints then the receiver's bounds may be larger than the cellBounds. THAT is a problem because the centering may not work correctly if the receiver shrinks after the owner layout has been computed. To avoid this problem, we compute the receiver's layout now. Note that the layout computation is based on the new cell bounds rather than the receiver's current bounds."
		cellBounds origin = self bounds origin ifFalse:[
			box := self outerBounds.
			delta := cellBounds origin - self bounds origin.
			self invalidRect: (box merge: (box translateBy: delta)).
			self privateFullMoveBy: delta]. "sigh..."
		box := cellBounds origin extent: "adjust for #rigid receiver"
			(self hResizing == #rigid ifTrue:[self bounds extent x] ifFalse:[cellBounds extent x]) @
			(self vResizing == #rigid ifTrue:[self bounds extent y] ifFalse:[cellBounds extent y]).
		"Compute inset of layout bounds"
		box := box origin - (self bounds origin - self layoutBounds origin) corner:
					box corner - (self bounds corner - self layoutBounds corner).
		"And do the layout within the new bounds"
		self layoutBounds: box.
		self doLayoutIn: box].
	cellBounds = self fullBounds ifTrue:[^self]. "already up to date"
	cellBounds extent = self fullBounds extent "nice fit"
		ifTrue:[^self position: cellBounds origin].
	box := bounds.
	"match #spaceFill constraints"
	self hResizing == #spaceFill 
		ifTrue:[box := box origin extent: cellBounds width @ box height].
	self vResizing == #spaceFill
		ifTrue:[box := box origin extent: box width @ cellBounds height].
	"align accordingly"
	aSymbol := (owner ifNil:[self]) cellPositioning.
	box := box align: (box perform: aSymbol) with: (cellBounds perform: aSymbol).
	"and install new bounds"
	self bounds: box.!

----- Method: Morph>>layoutInset (in category 'layout-properties') -----
layoutInset
	"Return the extra inset for layouts"
	| props |
	props := self layoutProperties.
	^props ifNil:[0] ifNotNil:[props layoutInset].!

----- Method: Morph>>layoutInset: (in category 'layout-properties') -----
layoutInset: aNumber
	"Return the extra inset for layouts"
	self assureTableProperties layoutInset: aNumber.
	self layoutChanged.!

----- Method: Morph>>layoutMenuPropertyString:from: (in category 'layout-menu') -----
layoutMenuPropertyString: aSymbol from: currentSetting 
	| onOff wording |
	onOff := aSymbol == currentSetting
				ifTrue: ['<on>']
				ifFalse: ['<off>'].
	""
	wording := String
				streamContents: [:stream | 
					| index | 
					index := 1.
					aSymbol
						keysAndValuesDo: [:idx :ch | ch isUppercase
								ifTrue: [""stream nextPutAll: (aSymbol copyFrom: index to: idx - 1) asLowercase.
									stream nextPutAll: ' '.
									index := idx]].
					index < aSymbol size
						ifTrue: [stream nextPutAll: (aSymbol copyFrom: index to: aSymbol size) asLowercase]].
	""
	^ onOff , wording translated!

----- Method: Morph>>layoutPolicy (in category 'layout-properties') -----
layoutPolicy
	"Layout specific. Return the layout policy describing how children 
	of the receiver should appear."
	^ extension ifNotNil: [ extension layoutPolicy]!

----- Method: Morph>>layoutPolicy: (in category 'layout-properties') -----
layoutPolicy: aLayoutPolicy
	"Layout specific. Return the layout policy describing how children of the receiver should appear."
	self layoutPolicy == aLayoutPolicy ifTrue:[^self].
	self assureExtension layoutPolicy: aLayoutPolicy.
	self layoutChanged.!

----- Method: Morph>>layoutProperties (in category 'layout-properties') -----
layoutProperties
	"Return the current layout properties associated with the  
	receiver"
	^ extension ifNotNil: [ extension layoutProperties]!

----- Method: Morph>>layoutProperties: (in category 'layout-properties') -----
layoutProperties: newProperties
	"Return the current layout properties associated with the receiver"
	self layoutProperties == newProperties ifTrue:[^self].
	self assureExtension layoutProperties: newProperties.
!

----- Method: Morph>>layoutProportionallyIn: (in category 'layout') -----
layoutProportionallyIn: newBounds
	"Layout specific. Apply the given bounds to the receiver."
	| box frame |
	frame := self layoutFrame ifNil:[^self].
	"before applying the proportional values make sure the receiver's layout is computed"
	self fullBounds. "sigh..."
	"compute the cell size the receiver has given its layout frame"
	box := frame layout: self bounds in: newBounds.
	(box = self bounds) ifTrue:[^self]. "no change"
	^self layoutInBounds: box.!

----- Method: Morph>>left (in category 'geometry') -----
left
	" Return the x-coordinate of my left side "

	^ bounds left!

----- Method: Morph>>left: (in category 'geometry') -----
left: aNumber
	" Move me so that my left side is at the x-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (aNumber @ bounds top)!

----- Method: Morph>>leftCenter (in category 'geometry') -----
leftCenter

	^ bounds leftCenter!

----- Method: Morph>>listCentering (in category 'layout-properties') -----
listCentering
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of primary direction
		#bottomRight - center at end of primary direction
		#center - center in the middle of primary direction
		#justified - insert extra space inbetween rows/columns
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topLeft] ifNotNil:[props listCentering].!

----- Method: Morph>>listCentering: (in category 'layout-properties') -----
listCentering: aSymbol
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of primary direction
		#bottomRight - center at end of primary direction
		#center - center in the middle of primary direction
		#justified - insert extra space inbetween rows/columns
	"
	self assureTableProperties listCentering: aSymbol.
	self layoutChanged.!

----- Method: Morph>>listCenteringString: (in category 'layout-properties') -----
listCenteringString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listCentering!

----- Method: Morph>>listDirection (in category 'layout-properties') -----
listDirection
	"Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
	indicating the direction in which any layout should take place"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topToBottom] ifNotNil:[props listDirection].!

----- Method: Morph>>listDirection: (in category 'layout-properties') -----
listDirection: aSymbol
	"Layout specific. This property describes the direction in which a list-like layout should be applied. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
	indicating the direction in which any layout should take place"
	self assureTableProperties listDirection: aSymbol.
	self layoutChanged.!

----- Method: Morph>>listDirectionString: (in category 'layout-properties') -----
listDirectionString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listDirection!

----- Method: Morph>>listSpacing (in category 'layout-properties') -----
listSpacing
	"Layout specific. This property describes how the heights for different rows in a table layout should be handled.
		#equal - all rows have the same height
		#none - all rows may have different heights
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props listSpacing].!

----- Method: Morph>>listSpacing: (in category 'layout-properties') -----
listSpacing: aSymbol
	"Layout specific. This property describes how the heights for different rows in a table layout should be handled.
		#equal - all rows have the same height
		#none - all rows may have different heights
	"
	self assureTableProperties listSpacing: aSymbol.
	self layoutChanged.!

----- Method: Morph>>listSpacingString: (in category 'layout-properties') -----
listSpacingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self listSpacing!

----- Method: Morph>>loadCachedState (in category 'caching') -----
loadCachedState
	"Load the cached state of this morph. This method may be called to pre-load the cached state of a morph to avoid delays when it is first used. (Cached state can always be recompued on demand, so a morph should not rely on this method being called.) Implementations of this method should do 'super loadCachedState'. This default implementation does nothing."
!

----- Method: Morph>>localPointToGlobal: (in category 'geometry') -----
localPointToGlobal: aPoint
	^self point: aPoint in: nil!

----- Method: Morph>>lock (in category 'accessing') -----
lock
	self lock: true!

----- Method: Morph>>lock: (in category 'accessing') -----
lock: aBoolean 
	"change the receiver's lock property"
	(extension isNil and: [aBoolean not]) ifTrue: [^ self].
	self assureExtension locked: aBoolean!

----- Method: Morph>>lockUnlockMorph (in category 'menus') -----
lockUnlockMorph
	"If the receiver is locked, unlock it; if unlocked, lock it"

	self isLocked ifTrue: [self unlock] ifFalse: [self lock]!

----- Method: Morph>>lockedString (in category 'menus') -----
lockedString
	"Answer the string to be shown in a menu to represent the 
	'locked' status"
	^ (self isLocked
		ifTrue: ['<on>']
		ifFalse: ['<off>']), 'be locked' translated!

----- Method: Morph>>mainDockingBars (in category 'submorphs-accessing') -----
mainDockingBars
	"Answer the receiver's main dockingBars"
	^ self dockingBars
		select: [:each | each hasProperty: #mainDockingBarTimeStamp]!

----- Method: Morph>>makeGraphPaper (in category 'e-toy support') -----
makeGraphPaper
	| smallGrid backColor lineColor |
	smallGrid := Compiler evaluate: (UIManager default request: 'Enter grid size' translated initialAnswer: '16').
	smallGrid ifNil: [^ self].
	Utilities informUser: 'Choose a background color' translated during: [backColor := Color fromUser].
	Utilities informUser: 'Choose a line color' translated during: [lineColor := Color fromUser].
	self makeGraphPaperGrid: smallGrid background: backColor line: lineColor.!

----- Method: Morph>>makeGraphPaperGrid:background:line: (in category 'e-toy support') -----
makeGraphPaperGrid: smallGrid background: backColor line: lineColor

	| gridForm |
	gridForm := self gridFormOrigin: 0 at 0 grid: smallGrid asPoint background: backColor line: lineColor.
	self color: gridForm.
	self world ifNotNil: [self world fullRepaintNeeded].
	self changed: #newColor.  "propagate to view"
!

----- Method: Morph>>makeMultipleSiblings: (in category 'meta-actions') -----
makeMultipleSiblings: evt
	"Make multiple siblings, first prompting the user for how many"

	| result |
	self topRendererOrSelf couldMakeSibling ifFalse: [^ Beeper beep].
	result := UIManager default request: 'how many siblings do you want?' translated initialAnswer: '2'.
	result isEmptyOrNil ifTrue: [^ self].
	result first isDigit ifFalse: [^ Beeper beep].
	self topRendererOrSelf makeSiblings: result asInteger.!

----- Method: Morph>>makeNascentScript (in category 'menus') -----
makeNascentScript
	^ self notYetImplemented!

----- Method: Morph>>makeNewPlayerInstance: (in category 'meta-actions') -----
makeNewPlayerInstance: evt
	"Make a duplicate of the receiver's argument.  This is called only where the argument has an associated Player as its costumee, and the intent here is to make another instance of the same uniclass as the donor Player itself.  Much works, but there are flaws so this shouldn't be used without recognizing the risks"

	evt hand attachMorph: self usableSiblingInstance!

----- Method: Morph>>makeSiblings: (in category 'meta-actions') -----
makeSiblings: count
	"Make multiple sibling, and return the list"

	| listOfNewborns aPosition |
	aPosition := self position.
	listOfNewborns := (1 to: count asInteger) asArray collect: 
		[:anIndex | | anInstance |
			anInstance := self usableSiblingInstance.
			owner addMorphFront: anInstance.
			aPosition := aPosition + (10 at 10).
			anInstance position: aPosition.
			anInstance].
	self currentWorld startSteppingSubmorphsOf: self topRendererOrSelf owner.
	^ listOfNewborns!

----- Method: Morph>>makeSiblingsLookLikeMe: (in category 'meta-actions') -----
makeSiblingsLookLikeMe: evt
	"Make all my siblings wear the same costume that I am wearing."

	| aPlayer |
	(aPlayer := self topRendererOrSelf player) belongsToUniClass ifFalse: [self error: 'not uniclass'].
	aPlayer class allInstancesDo:
		[:anInstance | anInstance == aPlayer ifFalse:
			[anInstance wearCostumeOf: aPlayer]]!

----- Method: Morph>>markAsPartsDonor (in category 'parts bin') -----
markAsPartsDonor
	"Mark the receiver specially so that mouse actions on it are interpreted as 'tearing off a copy'"

	self isPartsDonor: true!

----- Method: Morph>>maxCellSize (in category 'layout-properties') -----
maxCellSize
	"Layout specific. This property specifies the maximum size of a table cell."
	| props |
	props := self layoutProperties.
	^props ifNil:[SmallInteger maxVal] ifNotNil:[props maxCellSize].!

----- Method: Morph>>maxCellSize: (in category 'layout-properties') -----
maxCellSize: aPoint
	"Layout specific. This property specifies the maximum size of a table cell."
	self assureTableProperties maxCellSize: aPoint.
	self layoutChanged.!

----- Method: Morph>>maybeAddCollapseItemTo: (in category 'menus') -----
maybeAddCollapseItemTo: aMenu
	"If appropriate, add a collapse item to the given menu"

	| anOwner |
	(anOwner := self topRendererOrSelf owner) ifNotNil:
			[anOwner isWorldMorph ifTrue:
				[aMenu add: 'collapse' translated target: self action: #collapse]]!

----- Method: Morph>>maybeDuplicateMorph (in category 'meta-actions') -----
maybeDuplicateMorph
	"Maybe duplicate the morph"

	self okayToDuplicate ifTrue:
		[self topRendererOrSelf duplicate openInHand]!

----- Method: Morph>>maybeDuplicateMorph: (in category 'meta-actions') -----
maybeDuplicateMorph: evt
	self okayToDuplicate ifTrue:[^self duplicateMorph: evt]!

----- Method: Morph>>menuButtonMouseEnter: (in category 'other events') -----
menuButtonMouseEnter: event
	"The mouse entered a menu-button area; show the menu cursor temporarily"

	event hand showTemporaryCursor: Cursor menu!

----- Method: Morph>>menuButtonMouseLeave: (in category 'other events') -----
menuButtonMouseLeave: event
	"The mouse left a menu-button area; restore standard cursor"

	event hand showTemporaryCursor: nil!

----- Method: Morph>>menuItemAfter: (in category 'menus') -----
menuItemAfter: menuString
	| allWordings |
	allWordings := self allMenuWordings.
	^ allWordings atWrap: ((allWordings indexOf: menuString) + 1)!

----- Method: Morph>>menuItemBefore: (in category 'menus') -----
menuItemBefore: menuString
	| allWordings |
	allWordings := self allMenuWordings.
	^ allWordings atWrap: ((allWordings indexOf: menuString) - 1)!

----- Method: Morph>>methodCommentAsBalloonHelp (in category 'accessing') -----
methodCommentAsBalloonHelp
	"Given that I am a morph that is associated with an object and a method, answer a suitable method comment relating to that object & method if possible"

	| inherentSelector actual |
	(inherentSelector := self valueOfProperty: #inherentSelector)
		ifNotNil:
			[(actual := (self firstOwnerSuchThat:[:m| m isPhraseTileMorph or:[m isSyntaxMorph]]) actualObject) ifNotNil:
				[^ actual class precodeCommentOrInheritedCommentFor: inherentSelector]].
	^ nil!

----- Method: Morph>>minCellSize (in category 'layout-properties') -----
minCellSize
	"Layout specific. This property specifies the minimal size of a table cell."
	| props |
	props := self layoutProperties.
	^props ifNil:[0] ifNotNil:[props minCellSize].!

----- Method: Morph>>minCellSize: (in category 'layout-properties') -----
minCellSize: aPoint
	"Layout specific. This property specifies the minimal size of a table cell."
	self assureTableProperties minCellSize: aPoint.
	self layoutChanged.!

----- Method: Morph>>minExtent (in category 'layout') -----
minExtent
	"Layout specific. Return the minimum size the receiver can be represented in.
	Implementation note: When this message is sent from an owner trying to lay out its children it will traverse down the morph tree and recompute the minimal arrangement of the morphs based on which the minimal extent is returned. When a morph with some layout strategy is encountered, the morph will ask its strategy to compute the new arrangement. However, since the final size given to the receiver is unknown at the point of the query, the assumption is made that the current bounds of the receiver are the base on which the layout should be computed. This scheme prevents strange layout changes when for instance, a table is contained in another table. Unless the inner table has been resized manually (which means its bounds are already enlarged) the arrangement of the inner table will not change here. Thus the entire layout computation is basically an iterative process which may have different results depending on the incremental changes applied."

	| layout minExtent extra hFit vFit |
	hFit := self hResizing.
	vFit := self vResizing.
	(hFit == #spaceFill or: [vFit == #spaceFill]) 
		ifFalse: 
			["The receiver will not adjust to parents layout by growing or shrinking,
		which means that an accurate layout defines the minimum size."

			^self fullBounds extent].

	"An exception -- a receiver with #shrinkWrap constraints but no children is being treated #rigid (the equivalent to a #spaceFill receiver in a non-layouting owner)"
	self hasSubmorphs 
		ifFalse: 
			[hFit == #shrinkWrap ifTrue: [hFit := #rigid].
			vFit == #shrinkWrap ifTrue: [vFit := #rigid]].
	layout := self layoutPolicy.
	layout isNil 
		ifTrue: [minExtent := 0 @ 0]
		ifFalse: [minExtent := layout minExtentOf: self in: self layoutBounds].
	hFit == #rigid 
		ifTrue: [minExtent := self fullBounds extent x @ minExtent y]
		ifFalse: 
			[extra := self bounds width - self layoutBounds width.
			minExtent := (minExtent x + extra) @ minExtent y].
	minExtent := vFit == #rigid 
				ifTrue: [minExtent x @ self fullBounds extent y]
				ifFalse: 
					[extra := self bounds height - self layoutBounds height.
					minExtent x @ (minExtent y + extra)].
	minExtent := minExtent max: self minWidth @ self minHeight.
	^minExtent!

----- Method: Morph>>minHeight (in category 'layout') -----
minHeight
	"answer the receiver's minHeight"
	^ self
		valueOfProperty: #minHeight
		ifAbsent: [2]!

----- Method: Morph>>minHeight: (in category 'layout') -----
minHeight: aNumber 
	aNumber isNil 
		ifTrue: [self removeProperty: #minHeight]
		ifFalse: [self setProperty: #minHeight toValue: aNumber].
	self layoutChanged!

----- Method: Morph>>minWidth (in category 'layout') -----
minWidth
	"answer the receiver's minWidth"
	^ self
		valueOfProperty: #minWidth
		ifAbsent: [2]!

----- Method: Morph>>minWidth: (in category 'layout') -----
minWidth: aNumber 
	aNumber isNil 
		ifTrue: [self removeProperty: #minWidth]
		ifFalse: [self setProperty: #minWidth toValue: aNumber].
	self layoutChanged!

----- Method: Morph>>minimumExtent (in category 'geometry') -----
minimumExtent
	| ext |
	"This returns the minimum extent that the morph may be shrunk to.  Not honored in too many places yet, but respected by the resizeToFit feature, at least.  copied up from SystemWindow 6/00"
	(ext := self valueOfProperty: #minimumExtent)
		ifNotNil:
			[^ ext].
	^ 100 @ 80!

----- Method: Morph>>minimumExtent: (in category 'geometry') -----
minimumExtent: aPoint
	"Remember a minimumExtent, for possible future use"

	self setProperty: #minimumExtent toValue: aPoint
!

----- Method: Morph>>modalLockTo: (in category 'polymorph') -----
modalLockTo: aSystemWindow
	"Lock the receiver as a modal owner of the given window."

	self lock!

----- Method: Morph>>modalUnlockFrom: (in category 'polymorph') -----
modalUnlockFrom: aSystemWindow
	"Unlock the receiver as a modal owner of the given window."

	self unlock!

----- Method: Morph>>model (in category 'menus') -----
model
	^ nil !

----- Method: Morph>>modelOrNil (in category 'accessing') -----
modelOrNil
	^ nil!

----- Method: Morph>>models (in category 'model access') -----
models
	"Answer a collection of whatever models I may have."

	self modelOrNil ifNil: [ ^EmptyArray ].
	^Array with: self modelOrNil!

----- Method: Morph>>modificationHash (in category 'testing') -----
modificationHash

	^String 
		streamContents: [ :strm |
			self longPrintOn: strm
		]
		limitedTo: 25
!

----- Method: Morph>>morphPreceding: (in category 'structure') -----
morphPreceding: aSubmorph
	"Answer the morph immediately preceding aSubmorph, or nil if none"

	| anIndex |
	anIndex := submorphs indexOf: aSubmorph ifAbsent: [^ nil].
	^ anIndex > 1
		ifTrue:
			[submorphs at: (anIndex - 1)]
		ifFalse:
			[nil]!

----- Method: Morph>>morphReport (in category 'printing') -----
morphReport

	^self morphReportFor: #(hResizing vResizing bounds)!

----- Method: Morph>>morphReportFor: (in category 'printing') -----
morphReportFor: attributeList

	| s |

	s := WriteStream on: String new.
	self
		morphReportFor: attributeList 
		on: s 
		indent: 0.
	StringHolder new contents: s contents; openLabel: 'morph report'!

----- Method: Morph>>morphReportFor:on:indent: (in category 'printing') -----
morphReportFor: attributeList on: aStream indent: anInteger

	anInteger timesRepeat: [aStream tab].
	aStream print: self; space.
	attributeList do: [ :a | aStream print: (self perform: a); space].
	aStream cr.
	submorphs do: [ :sub |
		sub morphReportFor: attributeList on: aStream indent: anInteger + 1
	].!

----- Method: Morph>>morphRepresented (in category 'thumbnail') -----
morphRepresented
	"If the receiver is an alias, answer the morph it represents; else answer self"

	^ self!

----- Method: Morph>>morphToDropInPasteUp: (in category 'dropping/grabbing') -----
morphToDropInPasteUp: aPasteUp
	^ self!

----- Method: Morph>>morphicLayerNumber (in category 'WiW support') -----
morphicLayerNumber

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"

	^(owner isNil or: [owner isWorldMorph]) ifTrue: [
		self valueOfProperty: #morphicLayerNumber ifAbsent: [100]
	] ifFalse: [
		owner morphicLayerNumber
	].

	"leave lots of room for special things"!

----- Method: Morph>>morphicLayerNumberWithin: (in category 'WiW support') -----
morphicLayerNumberWithin: anOwner

	"helpful for insuring some morphs always appear in front of or behind others.
	smaller numbers are in front"

	^(owner isNil or: [owner isWorldMorph or: [anOwner == owner]]) ifTrue: [
		self valueOfProperty: #morphicLayerNumber ifAbsent: [100]
	] ifFalse: [
		owner morphicLayerNumber
	].

	"leave lots of room for special things"!

----- Method: Morph>>morphsAt: (in category 'submorphs-accessing') -----
morphsAt: aPoint
	"Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself.  The order is deepest embedding first."
	^self morphsAt: aPoint unlocked: false!

----- Method: Morph>>morphsAt:behind:unlocked: (in category 'submorphs-accessing') -----
morphsAt: aPoint behind: aMorph unlocked: aBool 
	"Return all morphs at aPoint that are behind frontMorph; if aBool is true return only unlocked, visible morphs."

	| isBack all tfm |
	all := (aMorph isNil or: [owner isNil]) 
				ifTrue: 
					["Traverse down"

					(self fullBounds containsPoint: aPoint) ifFalse: [^#()].
					(aBool and: [self isLocked or: [self visible not]]) ifTrue: [^#()].
					nil]
				ifFalse: 
					["Traverse up"

					tfm := self transformedFrom: owner.
					all := owner 
								morphsAt: (tfm localPointToGlobal: aPoint)
								behind: self
								unlocked: aBool.
					WriteStream with: all].
	isBack := aMorph isNil.
	self submorphsDo: 
			[:m | | found | 
			isBack 
				ifTrue: 
					[tfm := m transformedFrom: self.
					found := m 
								morphsAt: (tfm globalPointToLocal: aPoint)
								behind: nil
								unlocked: aBool.
					found notEmpty 
						ifTrue: 
							[all ifNil: [all := WriteStream on: #()].
							all nextPutAll: found]].
			m == aMorph ifTrue: [isBack := true]].
	(isBack and: [self containsPoint: aPoint]) 
		ifTrue: 
			[all ifNil: [^Array with: self].
			all nextPut: self].
	^all ifNil: [#()] ifNotNil: [all contents]!

----- Method: Morph>>morphsAt:unlocked: (in category 'submorphs-accessing') -----
morphsAt: aPoint unlocked: aBool
	"Return a collection of all morphs in this morph structure that contain the given point, possibly including the receiver itself.  The order is deepest embedding first."
	| mList |
	mList := WriteStream on: #().
	self morphsAt: aPoint unlocked: aBool do:[:m| mList nextPut: m].
	^mList contents!

----- Method: Morph>>morphsAt:unlocked:do: (in category 'submorphs-accessing') -----
morphsAt: aPoint unlocked: aBool do: aBlock
	"Evaluate aBlock with all the morphs starting at the receiver which appear at aPoint. If aBool is true take only visible, unlocked morphs into account."
	
	(self fullBounds containsPoint: aPoint) ifFalse:[^self].
	(aBool and:[self isLocked or:[self visible not]]) ifTrue:[^self].
	self submorphsDo:[:m| | tfm |
		tfm := m transformedFrom: self.
		m morphsAt: (tfm globalPointToLocal: aPoint) unlocked: aBool do: aBlock].
	(self containsPoint: aPoint) ifTrue:[aBlock value: self].!

----- Method: Morph>>morphsInFrontOf:overlapping:do: (in category 'submorphs-accessing') -----
morphsInFrontOf: someMorph overlapping: aRectangle do: aBlock
	"Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle. someMorph is either an immediate child of the receiver or nil (in which case all submorphs of the receiver are enumerated)."
	self submorphsDo:[:m|
		m == someMorph ifTrue:["Try getting out quickly"
			owner ifNil:[^self].
			^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock].
		(m fullBoundsInWorld intersects: aRectangle)
			ifTrue:[aBlock value: m]].
	owner ifNil:[^self].
	^owner morphsInFrontOf: self overlapping: aRectangle do: aBlock.!

----- Method: Morph>>morphsInFrontOverlapping: (in category 'submorphs-accessing') -----
morphsInFrontOverlapping: aRectangle
	"Return all top-level morphs in front of someMorph that overlap with the given rectangle."
	| morphList |
	morphList := WriteStream on: Array new.
	self morphsInFrontOf: nil overlapping: aRectangle do:[:m | morphList nextPut: m].
	^morphList contents!

----- Method: Morph>>morphsInFrontOverlapping:do: (in category 'submorphs-accessing') -----
morphsInFrontOverlapping: aRectangle do: aBlock
	"Evaluate aBlock with all top-level morphs in front of someMorph that overlap with the given rectangle."
	^self morphsInFrontOf: nil overlapping: aRectangle do: aBlock!

----- Method: Morph>>mouseDown: (in category 'event handling') -----
mouseDown: evt 
	"Handle a mouse down event. The default response is to let my 
	eventHandler, if any, handle it."
	evt yellowButtonPressed
		ifTrue: ["First check for option (menu) click"
			^ self yellowButtonActivity: evt shiftPressed].
	self eventHandler
		ifNotNil: [self eventHandler mouseDown: evt fromMorph: self]
!

----- Method: Morph>>mouseDownOnHelpHandle: (in category 'halos and balloon help') -----
mouseDownOnHelpHandle: anEvent
	"The mouse went down in the show-balloon handle"
	
	| str |
	anEvent shiftPressed ifTrue: [^ self editBalloonHelpText].
	str := self balloonText.
	str ifNil: [str := self noHelpString].
	self showBalloon: str hand: anEvent hand.
!

----- Method: Morph>>mouseDownPriority (in category 'events-processing') -----
mouseDownPriority
	"Return the default mouse down priority for the receiver"

	^ (self isPartsDonor or: [self isPartsBin])
		ifTrue:	[50]
		ifFalse:	[0]

	"The above is a workaround for the complete confusion between parts donors and parts bins. Morphs residing in a parts bin may or may not have the parts donor property set; if they have they may or may not actually handle events. To work around this, parts bins get an equal priority to parts donors so that when a morph in the parts bin does have the property set but does not handle the event we still get a copy from picking it up through the parts bin. Argh. This just *cries* for a cleanup."
	"And the above comment is Andreas's from 10/2000, which was formerly retrievable by a #flag: call which however caused a problem when trying to recompile the method from decompiled source."!

----- Method: Morph>>mouseEnter: (in category 'event handling') -----
mouseEnter: evt
	"Handle a mouseEnter event, meaning the mouse just entered my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseEnter: evt fromMorph: self].
!

----- Method: Morph>>mouseEnterDragging: (in category 'event handling') -----
mouseEnterDragging: evt
	"Handle a mouseEnterDragging event, meaning the mouse just entered my bounds with a button pressed or laden with submorphs.  The default response is to let my eventHandler, if any, handle it, or else to do nothing."

	self eventHandler ifNotNil:
		[^ self eventHandler mouseEnterDragging: evt fromMorph: self].
!

----- Method: Morph>>mouseLeave: (in category 'event handling') -----
mouseLeave: evt
	"Handle a mouseLeave event, meaning the mouse just left my bounds with no button pressed. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseLeave: evt fromMorph: self].
!

----- Method: Morph>>mouseLeaveDragging: (in category 'event handling') -----
mouseLeaveDragging: evt
	"Handle a mouseLeaveLaden event, meaning the mouse just left my bounds with a button pressed or laden with submorphs. The default response is to let my eventHandler, if any, handle it; else to do nothing."

	self eventHandler ifNotNil:
		[self eventHandler mouseLeaveDragging: evt fromMorph: self]!

----- Method: Morph>>mouseMove: (in category 'event handling') -----
mouseMove: evt
	"Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."
	self eventHandler ifNotNil:
		[self eventHandler mouseMove: evt fromMorph: self].
!

----- Method: Morph>>mouseStillDown: (in category 'event handling') -----
mouseStillDown: evt
	"Handle a mouse move event. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseStillDown: evt fromMorph: self].
!

----- Method: Morph>>mouseStillDownStepRate (in category 'geniestubs') -----
mouseStillDownStepRate
	"At what rate do I want to receive #mouseStillDown: notifications?"
	^1!

----- Method: Morph>>mouseStillDownThreshold (in category 'event handling') -----
mouseStillDownThreshold
	"Return the number of milliseconds after which mouseStillDown: should be sent"
	^200!

----- Method: Morph>>mouseUp: (in category 'event handling') -----
mouseUp: evt
	"Handle a mouse up event. The default response is to let my eventHandler, if any, handle it."

	self eventHandler ifNotNil:
		[self eventHandler mouseUp: evt fromMorph: self].
!

----- Method: Morph>>mouseUpCodeOrNil (in category 'debug and other') -----
mouseUpCodeOrNil
	"If the receiver has a mouseUpCodeToRun, return it, else return nil"

	^ self valueOfProperty: #mouseUpCodeToRun ifAbsent: [nil]!

----- Method: Morph>>move:toPosition: (in category 'geometry eToy') -----
move: aMorph toPosition: aPointOrNumber
	"Support for e-toy demo. Move the given submorph to the given position. Allows the morph's owner to determine the policy for motion. For example, moving forward through a table might mean motion only in the x-axis with wrapping modulo the table size."

	aMorph position: aPointOrNumber asPoint.
!

----- Method: Morph>>moveOrResizeFromKeystroke: (in category 'event handling') -----
moveOrResizeFromKeystroke: anEvent 
	"move or resize the receiver based on a keystroke"
	| dir | 

	anEvent keyValue = 28 ifTrue: [dir := -1 @ 0].
	anEvent keyValue = 29 ifTrue: [dir := 1 @ 0].
	anEvent keyValue = 30 ifTrue: [dir := 0 @ -1].
	anEvent keyValue = 31 ifTrue: [dir := 0 @ 1].

	dir notNil
		ifTrue:[
			anEvent controlKeyPressed ifTrue: [dir := dir * 10].

			anEvent shiftPressed
				ifTrue: [self extent: self extent + dir]
				ifFalse: [self position: self position + dir].

			"anEvent wasHandled: true."
	]
!

----- Method: Morph>>mustBeBackmost (in category 'e-toy support') -----
mustBeBackmost
	"Answer whether the receiver needs to be the backmost morph in its owner's submorph list"

	^ false!

----- Method: Morph>>name: (in category 'naming') -----
name: aName 
	(aName isString) ifTrue: [self setNameTo: aName]!

----- Method: Morph>>nameForFindWindowFeature (in category 'naming') -----
nameForFindWindowFeature
	"Answer the name to show in a list of windows-and-morphs to represent the receiver"

	^ self knownName ifNil: [self class name]!

----- Method: Morph>>nameForUndoWording (in category 'dropping/grabbing') -----
nameForUndoWording
	"Return wording appropriate to the receiver for use in an undo-related menu item (and perhaps elsewhere)"

	| aName |
	aName := self knownName ifNil: [self renderedMorph class name].
	^ aName truncateTo: 24!

----- Method: Morph>>nameInModel (in category 'naming') -----
nameInModel
	"Return the name for this morph in the underlying model or nil."

	| w |
	w := self world.
	w isNil ifTrue: [^nil] ifFalse: [^w model nameFor: self]!

----- Method: Morph>>nameOfObjectRepresented (in category 'naming') -----
nameOfObjectRepresented
	"Answer the external name of the object represented"

	^ self externalName!

----- Method: Morph>>nearestOwnerThat: (in category 'structure') -----
nearestOwnerThat: conditionBlock
	"Return the first enclosing morph for which aBlock evaluates to true, or nil if none"

	^ self firstOwnerSuchThat: conditionBlock
!

----- Method: Morph>>newTransformationMorph (in category 'rotate scale and flex') -----
newTransformationMorph
	^TransformationMorph new!

----- Method: Morph>>nextOwnerPage (in category 'geometry') -----
nextOwnerPage
	"Tell my container to advance to the next page"
	| targ |
	targ := self ownerThatIsA: BookMorph.
	targ ifNotNil: [targ nextPage]!

----- Method: Morph>>noHelpString (in category 'halos and balloon help') -----
noHelpString
	^ 'Help not yet supplied' translated!

----- Method: Morph>>noteDecimalPlaces:forGetter: (in category 'e-toy support') -----
noteDecimalPlaces: aNumber forGetter: aGetter
	"Make a mental note of the user's preference for a particular number of decimal places to be associated with the slot with the given getter"

	(self renderedMorph valueOfProperty: #decimalPlacePreferences ifAbsentPut: [IdentityDictionary new])
		at: aGetter put: aNumber!

----- Method: Morph>>noteNewOwner: (in category 'submorphs-accessing') -----
noteNewOwner: aMorph
	"I have just been added as a submorph of aMorph"!

----- Method: Morph>>objectForDataStream: (in category 'objects from disk') -----
objectForDataStream: refStrm 
	"I am being written out on an object file"

	| dp |
	self sqkPage ifNotNil: 
			[refStrm rootObject == self | (refStrm rootObject == self sqkPage) 
				ifFalse: 
					[self url notEmpty 
						ifTrue: 
							[dp := self sqkPage copyForSaving.	"be careful touching this object!!"
							refStrm replace: self with: dp.
							^dp]]].
	self prepareToBeSaved.	"Amen"
	^self!

----- Method: Morph>>objectViewed (in category 'e-toy support') -----
objectViewed
	"Answer the morph associated with the player that the structure the receiver currently finds itself within represents."

	^ (self outermostMorphThat: [:o | o isViewer or:[ o isScriptEditorMorph]]) objectViewed
!

----- Method: Morph>>obtrudesBeyondContainer (in category 'geometry testing') -----
obtrudesBeyondContainer
	"Answer whether the receiver obtrudes beyond the bounds of its container"

	| top |
	top := self topRendererOrSelf.
	(top owner isNil or: [top owner isHandMorph]) ifTrue: [^false].
	^(top owner bounds containsRect: top bounds) not!

----- Method: Morph>>offerCostumeViewerMenu: (in category 'menu') -----
offerCostumeViewerMenu: aMenu
	"do nothing"!

----- Method: Morph>>okayToAddDismissHandle (in category 'halos and balloon help') -----
okayToAddDismissHandle
	"Answer whether a halo on the receiver should offer a dismiss handle.  This provides a hook for making it harder to disassemble some strucures even momentarily"

	^ self resistsRemoval not!

----- Method: Morph>>okayToAddGrabHandle (in category 'halos and balloon help') -----
okayToAddGrabHandle
	"Answer whether a halo on the receiver should offer a grab handle.  This provides a hook for making it harder to deconstruct some strucures even momentarily"

	^ true!

----- Method: Morph>>okayToBrownDragEasily (in category 'halos and balloon help') -----
okayToBrownDragEasily
	"Answer whether it it okay for the receiver to be brown-dragged easily -- i.e. repositioned within its container without extracting it.  At present this is just a hook -- nobody declines."

	^ true



"
	^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
		[self layoutPolicy isNil]"!

----- Method: Morph>>okayToDuplicate (in category 'player') -----
okayToDuplicate
	"Formerly this protocol was used to guard against awkward situations when there were anonymous scripts in the etoy system.  Nowadays we just always allow duplication"

	^ true!

----- Method: Morph>>okayToExtractEasily (in category 'halos and balloon help') -----
okayToExtractEasily
	"Answer whether it it okay for the receiver to be extracted easily.  Not yet hooked up to the halo-permissions mechanism."

	^ self topRendererOrSelf owner dragNDropEnabled!

----- Method: Morph>>okayToResizeEasily (in category 'halos and balloon help') -----
okayToResizeEasily
	"Answer whether it is appropriate to have the receiver be easily resized by the user from the halo"

	^ true

	"This one was too jarring, not that it didn't most of the time do the right  thing but because some of the time it didn't, such as in a holder.  If we pursue this path, the test needs to be airtight, obviously...
	^ (self topRendererOrSelf owner isKindOf: PasteUpMorph) and:
		[self layoutPolicy isNil]"!

----- Method: Morph>>okayToRotateEasily (in category 'halos and balloon help') -----
okayToRotateEasily
	"Answer whether it is appropriate for a rotation handle to be shown for the receiver.  This is a hook -- at present nobody declines."

	^ true!

----- Method: Morph>>on:send:to: (in category 'event handling') -----
on: eventName send: selector to: recipient
	self eventHandler ifNil: [self eventHandler: EventHandler new].
	self eventHandler on: eventName send: selector to: recipient!

----- Method: Morph>>on:send:to:withValue: (in category 'event handling') -----
on: eventName send: selector to: recipient withValue: value
	"NOTE: selector must take 3 arguments, of which value will be the *** FIRST ***"

	self eventHandler ifNil: [self eventHandler: EventHandler new].
	self eventHandler on: eventName send: selector to: recipient withValue: value
!

----- Method: Morph>>openAPropertySheet (in category 'meta-actions') -----
openAPropertySheet

	Smalltalk at: #ObjectPropertiesMorph ifPresent:[:aClass|
		^aClass basicNew
			targetMorph: self;
			initialize;
			openNearTarget
	].
	Beeper beep.!

----- Method: Morph>>openATextPropertySheet (in category 'meta-actions') -----
openATextPropertySheet

	"should only be sent to morphs that are actually supportive"

	Smalltalk at: #TextPropertiesMorph ifPresent:[:aClass|
		^aClass basicNew
			targetMorph: self;
			initialize;
			openNearTarget
	].
	Beeper beep.!

----- Method: Morph>>openCenteredInWorld (in category 'initialization') -----
openCenteredInWorld

	self 
		fullBounds;
		position: Display extent - self extent // 2;
		openInWorld.!

----- Method: Morph>>openInHand (in category 'initialization') -----
openInHand
	"Attach the receiver to the current hand in the current morphic world"

	self currentHand attachMorph: self!

----- Method: Morph>>openInWindow (in category 'initialization') -----
openInWindow

	^self openInWindowLabeled: self defaultLabelForInspector
!

----- Method: Morph>>openInWindowLabeled: (in category 'initialization') -----
openInWindowLabeled: aString

	^self openInWindowLabeled: aString inWorld: self currentWorld!

----- Method: Morph>>openInWindowLabeled:inWorld: (in category 'initialization') -----
openInWindowLabeled: aString inWorld: aWorld

	| window extent |

	window := (SystemWindow labelled: aString) model: nil.
	window 
		" guess at initial extent"
		bounds:  (RealEstateAgent initialFrameFor: window initialExtent: self fullBounds extent world: aWorld);
		addMorph: self frame: (0 at 0 extent: 1 at 1);
		updatePaneColors.
	" calculate extent after adding in case any size related attributes were changed.  Use
	fullBounds in order to trigger re-layout of layout morphs"
	extent := self fullBounds extent + 
			(window borderWidth at window labelHeight) + window borderWidth.
	window extent: extent.
	aWorld addMorph: window.
	window activate.
	aWorld startSteppingSubmorphsOf: window.
	^window
!

----- Method: Morph>>openInWorld (in category 'initialization') -----
openInWorld
        "Add this morph to the world."

      self openInWorld: self currentWorld.!

----- Method: Morph>>openInWorld: (in category 'initialization') -----
openInWorld: aWorld
	"Add this morph to the requested World."
	(aWorld visibleClearArea origin ~= (0 at 0) and: [self position = (0 at 0)]) ifTrue:
		[self position: aWorld visibleClearArea origin].
	aWorld addMorph: self.
	aWorld startSteppingSubmorphsOf: self!

----- Method: Morph>>openModal: (in category 'polymorph') -----
openModal: aSystemWindow
	"Open the given window locking the receiver until it is dismissed.
	Answer the system window.
	Restore the original keyboard focus when closed."

	|area mySysWin keyboardFocus|
	keyboardFocus := self activeHand keyboardFocus.
	mySysWin := self isSystemWindow ifTrue: [self] ifFalse: [self ownerThatIsA: SystemWindow].
	mySysWin ifNil: [mySysWin := self].
	mySysWin modalLockTo: aSystemWindow.
	( RealEstateAgent respondsTo: #reduceByFlaps: )
		ifTrue:[
			area := RealEstateAgent reduceByFlaps: RealEstateAgent maximumUsableArea]
		ifFalse:[
			area := RealEstateAgent maximumUsableArea].
	aSystemWindow extent: aSystemWindow initialExtent.
	aSystemWindow position = (0 at 0)
		ifTrue: [aSystemWindow
				position: self activeHand position - (aSystemWindow extent // 2)].
	aSystemWindow
		bounds: (aSystemWindow bounds translatedToBeWithin: area).
	[ToolBuilder default runModal: aSystemWindow openAsIs]
		ensure: [mySysWin modalUnlockFrom: aSystemWindow.
				self activeHand newKeyboardFocus: keyboardFocus].
	^aSystemWindow!

----- Method: Morph>>openViewerForArgument (in category 'player viewer') -----
openViewerForArgument
	"Open up a viewer for a player associated with the morph in question. "
	self presenter viewMorph: self!

----- Method: Morph>>orOwnerSuchThat: (in category 'structure') -----
orOwnerSuchThat: conditionBlock

	(conditionBlock value: self) ifTrue: [^ self].
	self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [^ m]].
	^ nil

!

----- Method: Morph>>otherProperties (in category 'accessing - properties') -----
otherProperties
	"answer the receiver's otherProperties"
	^ extension ifNotNil: [extension otherProperties]!

----- Method: Morph>>outOfWorld: (in category 'initialization') -----
outOfWorld: aWorld
	"The receiver has just appeared in a new world. Notes:
		* aWorld can be nil (due to optimizations in other places)
		* owner is still valid
	Important: Keep this method fast - it is run whenever morphs are removed."
	aWorld ifNil:[^self].
	"ar 1/31/2001: We could explicitly stop stepping the receiver here but for the sake of speed I'm for now relying on the lazy machinery in the world itself."
	"aWorld stopStepping: self."
	self submorphsDo:[:m| m outOfWorld: aWorld].
!

----- Method: Morph>>outerBounds (in category 'geometry') -----
outerBounds
	"Return the 'outer' bounds of the receiver, e.g., the bounds that need to be invalidated when the receiver changes."
	| box |
	box := self bounds.
	self hasDropShadow ifTrue:[box := self expandFullBoundsForDropShadow: box].
	self hasRolloverBorder ifTrue:[box := self expandFullBoundsForRolloverBorder: box].
	^box!

----- Method: Morph>>outermostMorphThat: (in category 'structure') -----
outermostMorphThat: conditionBlock
	"Return the outermost containing morph for which aBlock is true, or nil if none"

	| outermost |
	self allOwnersDo: [:m | (conditionBlock value: m) ifTrue: [outermost := m]].
	^ outermost!

----- Method: Morph>>outermostOwnerWithYellowButtonMenu (in category 'menu') -----
outermostOwnerWithYellowButtonMenu
	"Answer me or my outermost owner that is willing to contribute menu items to a context menu.
	Don't include the world."

	| outermost |
	outermost := self outermostMorphThat: [ :ea |
		ea isWorldMorph not and: [ ea hasYellowButtonMenu ]].
	^outermost ifNil: [ self hasYellowButtonMenu ifTrue: [ self ] ifFalse: []] !

----- Method: Morph>>outermostWorldMorph (in category 'structure') -----
outermostWorldMorph

	| outer |
	World ifNotNil:[^World].
	self flag: #arNote. "stuff below is really only for MVC"
	outer := self outermostMorphThat: [ :x | x isWorldMorph].
	outer ifNotNil: [^outer].
	self isWorldMorph ifTrue: [^self].
	^nil!

----- Method: Morph>>overlapsShadowForm:bounds: (in category 'geometry') -----
overlapsShadowForm: itsShadow bounds: itsBounds
	"Answer true if itsShadow and my shadow overlap at all"
	| andForm overlapExtent |
	overlapExtent := (itsBounds intersect: self fullBounds) extent.
	overlapExtent > (0 @ 0)
		ifFalse: [^ false].
	andForm := self shadowForm.
	overlapExtent ~= self fullBounds extent
		ifTrue: [andForm := andForm
						contentsOfArea: (0 @ 0 extent: overlapExtent)].
	andForm := andForm
				copyBits: (self fullBounds translateBy: itsShadow offset negated)
				from: itsShadow
				at: 0 @ 0
				clippingBox: (0 @ 0 extent: overlapExtent)
				rule: Form and
				fillColor: nil.
	^ andForm bits
		anySatisfy: [:w | w ~= 0]!

----- Method: Morph>>owner (in category 'structure') -----
owner
	"Returns the owner of this morph, which may be nil."

	^ owner!

----- Method: Morph>>ownerChain (in category 'debug and other') -----
ownerChain
	"Answer a list of objects representing the receiver and all of its owners.   The first element is the receiver, and the last one is typically the world in which the receiver resides"

	| c next |
	c := OrderedCollection with: self.
	next := self.
	[(next := next owner) notNil] whileTrue: [c add: next].
	^c asArray!

----- Method: Morph>>ownerChanged (in category 'change reporting') -----
ownerChanged
	"The receiver's owner, some kind of a pasteup, has changed its layout."

	self snapToEdgeIfAppropriate!

----- Method: Morph>>ownerThatIsA: (in category 'structure') -----
ownerThatIsA: aClass
	"Return the first enclosing morph that is a kind of aClass, or nil if none"

	^ self firstOwnerSuchThat: [:m | m isKindOf: aClass]!

----- Method: Morph>>ownerThatIsA:orA: (in category 'structure') -----
ownerThatIsA: firstClass orA: secondClass
	"Return the first enclosing morph that is a kind of one of the two classes given, or nil if none"

	^ self firstOwnerSuchThat: [:m | (m isKindOf: firstClass) or: [m isKindOf: secondClass]]!

----- Method: Morph>>pagesHandledAutomatically (in category 'printing') -----
pagesHandledAutomatically

	^false!

----- Method: Morph>>partRepresented (in category 'parts bin') -----
partRepresented
	^self!

----- Method: Morph>>pasteUpMorph (in category 'structure') -----
pasteUpMorph
	"Answer the closest containing morph that is a PasteUp morph"
	^ self ownerThatIsA: PasteUpMorph!

----- Method: Morph>>pasteUpMorphHandlingTabAmongFields (in category 'structure') -----
pasteUpMorphHandlingTabAmongFields
	"Answer the nearest PasteUpMorph in my owner chain that has the tabAmongFields property, or nil if none"

	| aPasteUp |
	aPasteUp := self owner.
	[aPasteUp notNil] whileTrue:
		[aPasteUp tabAmongFields ifTrue:
			[^ aPasteUp].
		aPasteUp := aPasteUp owner].
	^ nil!

----- Method: Morph>>permitsThumbnailing (in category 'thumbnail') -----
permitsThumbnailing
	^ true!

----- Method: Morph>>playSoundNamed: (in category 'player commands') -----
playSoundNamed: soundName
	"Play the sound with the given name.
	Does nothing if this image lacks sound playing facilities."

	SoundService default playSoundNamed: soundName asString!

----- Method: Morph>>player (in category 'accessing') -----
player
	"answer the receiver's player"
	^ extension ifNotNil: [extension player]!

----- Method: Morph>>player: (in category 'accessing') -----
player: anObject 
	"change the receiver's player"
	self assureExtension player: anObject!

----- Method: Morph>>playerRepresented (in category 'accessing') -----
playerRepresented
	"Answer the player represented by the receiver.  Morphs that serve as references to other morphs reimplement this; be default a morph represents its own player."

	^ self player!

----- Method: Morph>>point:from: (in category 'geometry') -----
point: aPoint from: aReferenceMorph

	owner ifNil: [^ aPoint].
	^ (owner transformFrom: aReferenceMorph) globalPointToLocal: aPoint.
!

----- Method: Morph>>point:in: (in category 'geometry') -----
point: aPoint in: aReferenceMorph

	owner ifNil: [^ aPoint].
	^ (owner transformFrom: aReferenceMorph) localPointToGlobal: aPoint.
!

----- Method: Morph>>pointFromWorld: (in category 'geometry') -----
pointFromWorld: aPoint
	^self point: aPoint from: self world!

----- Method: Morph>>pointInWorld: (in category 'geometry') -----
pointInWorld: aPoint
	^self point: aPoint in: self world!

----- Method: Morph>>position (in category 'geometry') -----
position

	^ bounds topLeft!

----- Method: Morph>>position: (in category 'geometry') -----
position: aPoint 
	"Change the position of this morph and and all of its
	submorphs. "
	| delta box |
	delta := (aPoint - bounds topLeft) rounded.
	(delta x = 0
			and: [delta y = 0])
		ifTrue: [^ self].
	"Null change"
	box := self fullBounds.
	(delta dotProduct: delta)
			> 100
		ifTrue: ["e.g., more than 10 pixels moved"
			self invalidRect: box.
			self
				invalidRect: (box translateBy: delta)]
		ifFalse: [self
				invalidRect: (box
						merge: (box translateBy: delta))].
	self privateFullMoveBy: delta.
	owner
		ifNotNil: [owner layoutChanged]!

----- Method: Morph>>positionInWorld (in category 'geometry') -----
positionInWorld

	^ self pointInWorld: self position.
!

----- Method: Morph>>positionSubmorphs (in category 'geometry') -----
positionSubmorphs
	self submorphsDo:
		[:aMorph | aMorph snapToEdgeIfAppropriate]!

----- Method: Morph>>potentialEmbeddingTargets (in category 'meta-actions') -----
potentialEmbeddingTargets
	"Return the potential targets for embedding the receiver"

	| oneUp topRend |
	(oneUp := (topRend := self topRendererOrSelf) owner) ifNil:[^#()].
	^ (oneUp morphsAt: topRend referencePosition behind: topRend unlocked: true) select:
		[:m | m  isFlexMorph not]!

----- Method: Morph>>potentialTargets (in category 'meta-actions') -----
potentialTargets
	"Return the potential targets for the receiver.
	This is derived from Morph>>potentialEmbeddingTargets."
	owner ifNil:[^#()].
	^owner morphsAt: self referencePosition behind: self unlocked: true not!

----- Method: Morph>>potentialTargetsAt: (in category 'meta-actions') -----
potentialTargetsAt: aPoint 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	| realOwner |
	realOwner := self topRendererOrSelf
	owner
		ifNil: [^ #()].
	^ realOwner
		morphsAt: aPoint
		!

----- Method: Morph>>preferredDuplicationHandleSelector (in category 'halos and balloon help') -----
preferredDuplicationHandleSelector
	"Answer the selector, either #addMakeSiblingHandle: or addDupHandle:, to be offered as the default in a halo open on me"

	Preferences oliveHandleForScriptedObjects ifFalse:
		[^ #addDupHandle:].
	^ self renderedMorph valueOfProperty: #preferredDuplicationHandleSelector ifAbsent:
		[self player class isUniClass
			ifTrue:
				[#addMakeSiblingHandle:]
			ifFalse:
				[#addDupHandle:]]!

----- Method: Morph>>preferredKeyboardBounds (in category 'event handling') -----
preferredKeyboardBounds

	^ self bounds: self bounds in: World.
!

----- Method: Morph>>preferredKeyboardPosition (in category 'event handling') -----
preferredKeyboardPosition

	^ (self bounds: self bounds in: World) topLeft.
!

----- Method: Morph>>prepareToBeSaved (in category 'fileIn/out') -----
prepareToBeSaved
	"Prepare this morph to be saved to disk. Subclasses should nil out any instance variables that holds state that should not be saved, such as cached Forms. Note that this operation may take more drastic measures than releaseCachedState; for example, it might discard the transcript of an interactive chat session."

	self releaseCachedState.
	self formerOwner: nil.
	self formerPosition: nil.
	self removeProperty: #undoGrabCommand.
	fullBounds := nil!

----- Method: Morph>>presentHelp (in category 'menus') -----
presentHelp
	"Present a help message if there is one available"

	self inform: 'Sorry, no help has been
provided here yet.'!

----- Method: Morph>>presenter (in category 'accessing') -----
presenter
	^ owner ifNotNil: [owner presenter] ifNil: [self currentWorld presenter]!

----- Method: Morph>>previousOwnerPage (in category 'geometry') -----
previousOwnerPage
	"Tell my container to advance to the previous page"
	| targ |
	targ := self ownerThatIsA: BookMorph.
	targ ifNotNil: [targ previousPage]!

----- Method: Morph>>primaryHand (in category 'structure') -----
primaryHand

        | outer |
        outer := self outermostWorldMorph ifNil: [^ nil].
        ^ outer activeHand ifNil: [outer firstHand]!

----- Method: Morph>>printConstructorOn:indent: (in category 'printing') -----
printConstructorOn: aStream indent: level

	^ self printConstructorOn: aStream indent: level nodeDict: IdentityDictionary new
!

----- Method: Morph>>printConstructorOn:indent:nodeDict: (in category 'printing') -----
printConstructorOn: aStream indent: level nodeDict: nodeDict
	| nodeString |
	(nodeString := nodeDict at: self ifAbsent: [nil])
		ifNotNil: [^ aStream nextPutAll: nodeString].
	submorphs isEmpty ifFalse: [aStream nextPutAll: '('].
	aStream nextPutAll: '('.
	self fullPrintOn: aStream.
	aStream nextPutAll: ')'.
	submorphs isEmpty ifTrue: [^ self].
	submorphs size <= 4
	ifTrue:
		[aStream crtab: level+1;
			nextPutAll: 'addAllMorphs: (Array'.
		1 to: submorphs size do:
			[:i | aStream crtab: level+1; nextPutAll: 'with: '.
			(submorphs at: i) printConstructorOn: aStream indent: level+1 nodeDict: nodeDict].
		aStream nextPutAll: '))']
	ifFalse:
		[aStream crtab: level+1;
			nextPutAll: 'addAllMorphs: ((Array new: ', submorphs size printString, ')'.
		1 to: submorphs size do:
			[:i |
			aStream crtab: level+1; nextPutAll: 'at: ', i printString, ' put: '.
			(submorphs at: i) printConstructorOn: aStream indent: level+1 nodeDict: nodeDict.
			aStream nextPutAll: ';'].
		aStream crtab: level+1; nextPutAll: 'yourself))']!

----- Method: Morph>>printOn: (in category 'printing') -----
printOn: aStream 
	| aName |
	super printOn: aStream.
	(aName := self knownName) notNil 
		ifTrue: [aStream nextPutAll: '<' , aName , '>'].
	aStream nextPutAll: '('.
	aStream
		print: self identityHash;
		nextPutAll: ')'!

----- Method: Morph>>printPSToFileNamed: (in category 'menus') -----
printPSToFileNamed: aString 
	"Ask the user for a filename and print this morph as postscript."
	| fileName rotateFlag psCanvasType psExtension |
	fileName := aString asFileName.
	psCanvasType := PostscriptCanvas defaultCanvasType.
	psExtension := psCanvasType defaultExtension.
	fileName := UIManager default request: (String streamContents: [ :s |
		s nextPutAll: ('File name? ("{1}" will be added to end)' translated format: {psExtension})])
			initialAnswer: fileName.
	fileName isEmpty
		ifTrue: [^ Beeper beep].
	(fileName endsWith: psExtension)
		ifFalse: [fileName := fileName , psExtension].
	rotateFlag := (UIManager default chooseFrom: {
		'portrait (tall)' translated.
		'landscape (wide)' translated.
	} title: 'Choose orientation...' translated) = 2.
	((FileStream newFileNamed: fileName asFileName) converter: TextConverter defaultSystemConverter)
		nextPutAll: (psCanvasType morphAsPostscript: self rotated: rotateFlag);
		 close!

----- Method: Morph>>printSpecs (in category 'printing') -----
printSpecs

	| printSpecs |

	printSpecs := self valueOfProperty: #PrintSpecifications.
	printSpecs ifNil: [
		printSpecs := PrintSpecifications defaultSpecs.
		self printSpecs: printSpecs.
	].
	^printSpecs!

----- Method: Morph>>printSpecs: (in category 'printing') -----
printSpecs: aPrintSecification

	self setProperty: #PrintSpecifications toValue: aPrintSecification.
!

----- Method: Morph>>printStructureOn:indent: (in category 'printing') -----
printStructureOn: aStream indent: tabCount

	tabCount timesRepeat: [aStream tab].
	self printOn: aStream.
	aStream cr.
	self submorphsDo: [:m | m printStructureOn: aStream indent: tabCount + 1].
!

----- Method: Morph>>privateAddAllMorphs:atIndex: (in category 'private') -----
privateAddAllMorphs: aCollection atIndex: index
	"Private. Add aCollection of morphs to the receiver"
	| myWorld otherSubmorphs |
	myWorld := self world.
	otherSubmorphs := submorphs copyWithoutAll: aCollection.
	(index between: 0 and: otherSubmorphs size)
		ifFalse: [^ self error: 'index out of range'].
	index = 0
		ifTrue:[	submorphs := aCollection asArray, otherSubmorphs]
		ifFalse:[	index = otherSubmorphs size
			ifTrue:[	submorphs := otherSubmorphs, aCollection]
			ifFalse:[	submorphs := otherSubmorphs copyReplaceFrom: index + 1 to: index with: aCollection ]].
	aCollection do: [:m | | itsOwner itsWorld |
		itsOwner := m owner.
		itsOwner ifNotNil: [
			itsWorld := m world.
			(itsWorld == myWorld) ifFalse: [
				itsWorld ifNotNil: [self privateInvalidateMorph: m].
				m outOfWorld: itsWorld].
			(itsOwner ~~ self) ifTrue: [
				m owner privateRemove: m.
				m owner removedMorph: m ]].
		m privateOwner: self.
		myWorld ifNotNil: [self privateInvalidateMorph: m].
		(myWorld == itsWorld) ifFalse: [m intoWorld: myWorld].
		itsOwner == self ifFalse: [
			self addedMorph: m.
			m noteNewOwner: self ].
	].
	self layoutChanged.
!

----- Method: Morph>>privateAddMorph:atIndex: (in category 'private') -----
privateAddMorph: aMorph atIndex: index

	| oldIndex myWorld itsWorld oldOwner |
	((index >= 1) and: [index <= (submorphs size + 1)])
		ifFalse: [^ self error: 'index out of range'].
	myWorld := self world.
	oldOwner := aMorph owner.
	(oldOwner == self and: [(oldIndex := submorphs indexOf: aMorph) > 0]) ifTrue:[
		"aMorph's position changes within in the submorph chain"
		oldIndex < index ifTrue:[
			"moving aMorph to back"
			submorphs replaceFrom: oldIndex to: index-2 with: submorphs startingAt: oldIndex+1.
			submorphs at: index-1 put: aMorph.
		] ifFalse:[
			"moving aMorph to front"
			oldIndex-1 to: index by: -1 do:[:i|
				submorphs at: i+1 put: (submorphs at: i)].
			submorphs at: index put: aMorph.
		].
	] ifFalse:[
		"adding a new morph"
		oldOwner ifNotNil:[
			itsWorld := aMorph world.
			itsWorld ifNotNil: [self privateInvalidateMorph: aMorph].
			(itsWorld == myWorld) ifFalse: [aMorph outOfWorld: itsWorld].
			oldOwner privateRemove: aMorph.
			oldOwner removedMorph: aMorph.
		].
		aMorph privateOwner: self.
		submorphs := submorphs copyReplaceFrom: index to: index-1 with: (Array with: aMorph).
		(itsWorld == myWorld) ifFalse: [aMorph intoWorld: myWorld].
	].
	myWorld ifNotNil:[self privateInvalidateMorph: aMorph].
	self layoutChanged.
	oldOwner == self ifFalse: [
		self addedMorph: aMorph.
		aMorph noteNewOwner: self ].
!

----- Method: Morph>>privateBounds: (in category 'private') -----
privateBounds: boundsRect
	"Private!! Use position: and/or extent: instead."

	fullBounds := nil.
	bounds := boundsRect.!

----- Method: Morph>>privateColor: (in category 'private') -----
privateColor: aColor

	color := aColor.
!

----- Method: Morph>>privateDelete (in category 'submorphs-add/remove') -----
privateDelete
	"Remove the receiver as a submorph of its owner"
	owner ifNotNil:[owner removeMorph: self].!

----- Method: Morph>>privateDeleteWithAbsolutelyNoSideEffects (in category 'private') -----
privateDeleteWithAbsolutelyNoSideEffects
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."
	"used to delete a morph from an inactive world"

	owner ifNil: [^self].
	owner privateRemoveMorphWithAbsolutelyNoSideEffects: self.
	owner := nil.

!

----- Method: Morph>>privateExtension: (in category 'accessing - extension') -----
privateExtension: aMorphExtension
	"private - change the receiver's extension"
	extension := aMorphExtension!

----- Method: Morph>>privateFullBounds (in category 'layout') -----
privateFullBounds
	"Private. Compute the actual full bounds of the receiver"

	| box |
	submorphs isEmpty ifTrue: [^self outerBounds].
	box := self outerBounds copy.
	box := box quickMerge: (self clipSubmorphs 
						ifTrue: [self submorphBounds intersect: self clippingBounds]
						ifFalse: [self submorphBounds]).
	^box origin asIntegerPoint corner: box corner asIntegerPoint!

----- Method: Morph>>privateFullBounds: (in category 'private') -----
privateFullBounds: boundsRect
	"Private!! Computed automatically."

	fullBounds := boundsRect.!

----- Method: Morph>>privateFullMoveBy: (in category 'private') -----
privateFullMoveBy: delta
	"Private!! Relocate me and all of my subMorphs by recursion. Subclasses that implement different coordinate systems may override this method."

	self privateMoveBy: delta.
	1 to: submorphs size do: [:i |
		(submorphs at: i) privateFullMoveBy: delta].
	owner ifNotNil:[
		owner isTextMorph ifTrue:[owner adjustTextAnchor: self]].!

----- Method: Morph>>privateInvalidateMorph: (in category 'change reporting') -----
privateInvalidateMorph: aMorph
	"Private. Invalidate the given morph after adding or removing.
	This method is private because a) we're invalidating the morph 'remotely'
	and b) it forces a fullBounds computation which should not be necessary
	for a general morph c) the morph may or may not actually invalidate
	anything (if it's not in the world nothing will happen) and d) the entire
	mechanism should be rewritten."
	aMorph fullBounds.
	aMorph changed!

----- Method: Morph>>privateMoveBy: (in category 'private') -----
privateMoveBy: delta 
	"Private!! Use 'position:' instead."
	| fill |
	self player ifNotNil: ["Most cases eliminated fast by above test"
		self getPenDown ifTrue: [
			"If this is a costume for a player with its 
			pen down, draw a line."
			self moveWithPenDownBy: delta]].
	bounds := bounds translateBy: delta.
	fullBounds ifNotNil: [fullBounds := fullBounds translateBy: delta].
	fill := self fillStyle.
	fill isOrientedFill ifTrue: [fill origin: fill origin + delta]!

----- Method: Morph>>privateOwner: (in category 'private') -----
privateOwner: aMorph
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	owner := aMorph.!

----- Method: Morph>>privateRemove: (in category 'private') -----
privateRemove: aMorph
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	submorphs := submorphs copyWithout: aMorph.
	self layoutChanged.!

----- Method: Morph>>privateRemoveMorphWithAbsolutelyNoSideEffects: (in category 'private') -----
privateRemoveMorphWithAbsolutelyNoSideEffects: aMorph
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."
	"used to delete a morph from an inactive world"

	submorphs := submorphs copyWithout: aMorph.

!

----- Method: Morph>>privateSubmorphs (in category 'private') -----
privateSubmorphs
	"Private!! Use 'submorphs' instead."

	^ submorphs!

----- Method: Morph>>privateSubmorphs: (in category 'private') -----
privateSubmorphs: aCollection
	"Private!! Should only be used by methods that maintain the ower/submorph invariant."

	submorphs := aCollection.!

----- Method: Morph>>processEvent: (in category 'events-processing') -----
processEvent: anEvent
	"Process the given event using the default event dispatcher."
	^self processEvent: anEvent using: self defaultEventDispatcher!

----- Method: Morph>>processEvent:using: (in category 'events-processing') -----
processEvent: anEvent using: defaultDispatcher
	"This is the central entry for dispatching events in morphic. Given some event and a default dispatch strategy, find the right receiver and let him handle it.
	WARNING: This is a powerful hook. If you want to use a different event dispatcher from the default, here is the place to hook it in. Depending on how the dispatcher is written (e.g., whether it calls simply #processEvent: or #processEvent:using:) you can change the dispatch strategy for entire trees of morphs. Similarly, you can disable entire trees of morphs from receiving any events whatsoever. Read the documentation in class MorphicEventDispatcher before playing with it. "
	(self rejectsEvent: anEvent) ifTrue:[^#rejected].
	^defaultDispatcher dispatchEvent: anEvent with: self!

----- Method: Morph>>programmedMouseDown:for: (in category 'debug and other') -----
programmedMouseDown: anEvent for: aMorph

	aMorph addMouseActionIndicatorsWidth: 15 color: (Color blue alpha: 0.7).

!

----- Method: Morph>>programmedMouseEnter:for: (in category 'debug and other') -----
programmedMouseEnter: anEvent for: aMorph

	aMorph addMouseActionIndicatorsWidth: 10 color: (Color blue alpha: 0.3).

!

----- Method: Morph>>programmedMouseLeave:for: (in category 'debug and other') -----
programmedMouseLeave: anEvent for: aMorph

	self deleteAnyMouseActionIndicators.
!

----- Method: Morph>>programmedMouseUp:for: (in category 'debug and other') -----
programmedMouseUp: anEvent for: aMorph 
	| aCodeString |
	self deleteAnyMouseActionIndicators.
	aCodeString := self valueOfProperty: #mouseUpCodeToRun ifAbsent: [^self].
	(self fullBounds containsPoint: anEvent cursorPoint) ifFalse: [^self].
	
	[(aCodeString isMessageSend) 
		ifTrue: [aCodeString value]
		ifFalse: 
			[Compiler 
				evaluate: aCodeString
				for: self
				notifying: nil
				logged: false]] 
			on: ProgressTargetRequestNotification
			do: [:ex | ex resume: self]	"in case a save/load progress display needs a home"!

----- Method: Morph>>raisedColor (in category 'accessing') -----
raisedColor
	"Return the color to be used for shading raised borders. The 
	default is my own color, but it might want to be, eg, my 
	owner's color. Whoever's color ends up prevailing, the color 
	itself gets the last chance to determine, so that when, for 
	example, an InfiniteForm serves as the color, callers won't choke 
	on some non-Color object being returned"
	(color isColor
			and: [color isTransparent
					and: [owner notNil]])
		ifTrue: [^ owner raisedColor].
	^ color asColor raisedColor!

----- Method: Morph>>randomBoundsFor: (in category 'WiW support') -----
randomBoundsFor: aMorph

	| trialRect |
	trialRect := (
		self topLeft + 
			((self width * (15 + 75 atRandom/100)) rounded @
			(self height * (15 + 75 atRandom/100)) rounded)
	) extent: aMorph extent.
	^trialRect translateBy: (trialRect amountToTranslateWithin: self bounds)
!

----- Method: Morph>>readoutForField: (in category 'thumbnail') -----
readoutForField: fieldSym
	"Provide a readout that will show the value of the slot/pseudoslot of the receiver generated by sending fieldSym to the receiver"

	| aContainer |
	"still need to get this right"
	aContainer := AlignmentMorph newColumn.
	aContainer layoutInset: 0; hResizing: #rigid; vResizing: #shrinkWrap.
	aContainer addMorphBack: (StringMorph new contents: (self perform: fieldSym) asString).
	^ aContainer!

----- Method: Morph>>reasonableBitmapFillForms (in category 'menus') -----
reasonableBitmapFillForms
	"Answer an OrderedCollection of forms that could be used to replace my bitmap fill, with my current form first."
	| reasonableForms myGraphic |
	reasonableForms := self class allSketchMorphForms.
	reasonableForms addAll: Imports default images.
	reasonableForms addAll: (BitmapFillStyle allSubInstances collect:[:f| f form]).
	reasonableForms
		remove: (myGraphic := self fillStyle form)
		ifAbsent: [].
	reasonableForms := reasonableForms asOrderedCollection.
	reasonableForms addFirst: myGraphic.
	^reasonableForms!

----- Method: Morph>>reasonableForms (in category 'menus') -----
reasonableForms
	"Answer an OrderedCollection of forms that could be used to replace my form, with my current form first."
	| reasonableForms myGraphic |
	reasonableForms := self class allSketchMorphForms.
	reasonableForms addAll: Imports default images.
	reasonableForms
		remove: (myGraphic := self form)
		ifAbsent: [].
	reasonableForms := reasonableForms asOrderedCollection.
	reasonableForms addFirst: myGraphic.
	^reasonableForms!

----- Method: Morph>>redButtonGestureDictionaryOrName: (in category 'geniestubs') -----
redButtonGestureDictionaryOrName: aSymbolOrDictionary!

----- Method: Morph>>referencePlayfield (in category 'e-toy support') -----
referencePlayfield
	"Answer the PasteUpMorph to be used for cartesian-coordinate reference"

	| former |
	owner ifNotNil:
		[(self topRendererOrSelf owner isHandMorph and: [(former := self formerOwner) notNil])
			ifTrue:
				[former := former renderedMorph.
				^ former isPlayfieldLike 
					ifTrue: [former]
					ifFalse: [former referencePlayfield]]].

	self allOwnersDo: [:o | o isPlayfieldLike ifTrue: [^ o]].
	^ ActiveWorld!

----- Method: Morph>>referencePosition (in category 'geometry eToy') -----
referencePosition
	"Return the current reference position of the receiver"
	| box |
	box := self bounds.
	^box origin + (self rotationCenter * box extent).
!

----- Method: Morph>>referencePosition: (in category 'geometry eToy') -----
referencePosition: aPosition
	"Move the receiver to match its reference position with aPosition"
	| newPos intPos |
	newPos := self position + (aPosition - self referencePosition).
	intPos := newPos asIntegerPoint.
	newPos = intPos 
		ifTrue:[self position: intPos]
		ifFalse:[self position: newPos].!

----- Method: Morph>>referencePositionInWorld (in category 'geometry eToy') -----
referencePositionInWorld

	^ self pointInWorld: self referencePosition
!

----- Method: Morph>>referencePositionInWorld: (in category 'geometry eToy') -----
referencePositionInWorld: aPoint
	| localPosition |
	localPosition := owner
		ifNil: [aPoint]
		ifNotNil: [(owner transformFrom: self world) globalPointToLocal: aPoint].

	self referencePosition: localPosition
!

----- Method: Morph>>refreshWorld (in category 'drawing') -----
refreshWorld
	| aWorld |
	(aWorld := self world) ifNotNil: [aWorld displayWorldSafely]
!

----- Method: Morph>>regularColor (in category 'accessing') -----
regularColor
	
	| val |
	^ (val := self valueOfProperty: #regularColor)
		ifNotNil:
			[val ifNil: [self error: 'nil regularColor']]
		ifNil:
			[owner ifNil: [self color] ifNotNil: [owner regularColor]]!

----- Method: Morph>>regularColor: (in category 'accessing') -----
regularColor: aColor
	self setProperty: #regularColor toValue: aColor!

----- Method: Morph>>rejectDropEvent: (in category 'events-processing') -----
rejectDropEvent: anEvent
	"This hook allows the receiver to repel a drop operation currently executed. The method is called prior to checking children so the receiver must validate that the event was really designated for it.
	Note that the ordering of the tests below is designed to avoid a (possibly expensive) #fullContainsPoint: test. If the receiver doesn't want to repel the morph anyways we don't need to check after all."
	(self repelsMorph: anEvent contents event: anEvent) ifFalse:[^self]. "not repelled"
	(self fullContainsPoint: anEvent position) ifFalse:[^self]. "not for me"
	"Throw it away"
	anEvent wasHandled: true.
	anEvent contents rejectDropMorphEvent: anEvent.!

----- Method: Morph>>rejectDropMorphEvent: (in category 'dropping/grabbing') -----
rejectDropMorphEvent: evt
	"The receiver has been rejected, and must be put back somewhere.  There are three cases:
	(1)  It remembers its former owner and position, and goes right back there
	(2)  It remembers its former position only, in which case it was torn off from a parts bin, and the UI is that it floats back to its donor position and then vanishes.
	(3)  Neither former owner nor position is remembered, in which case it is whisked to the Trash"

	self removeProperty: #undoGrabCommand.
	(self formerOwner notNil and: [self formerOwner isPartsBin not]) ifTrue:
		[^ self slideBackToFormerSituation: evt].

	self formerPosition ifNotNil:  "Position but no owner -- can just make it vanish"
		[^ self vanishAfterSlidingTo: self formerPosition event: evt].
		
	self slideToTrash: evt!

----- Method: Morph>>rejectsEvent: (in category 'events-processing') -----
rejectsEvent: anEvent
	"Return true to reject the given event. Rejecting an event means neither the receiver nor any of it's submorphs will be given any chance to handle it."
	^self isLocked or:[self visible not]!

----- Method: Morph>>relativeTextAnchorPosition (in category 'text-anchor') -----
relativeTextAnchorPosition
	^self valueOfProperty: #relativeTextAnchorPosition!

----- Method: Morph>>relativeTextAnchorPosition: (in category 'text-anchor') -----
relativeTextAnchorPosition: aPoint
	^self setProperty: #relativeTextAnchorPosition toValue: aPoint!

----- Method: Morph>>releaseActionMap (in category 'events-removing') -----
releaseActionMap
	"Release the action map"
	
 	self removeProperty: #actionMap!

----- Method: Morph>>releaseCachedState (in category 'caching') -----
releaseCachedState
	"Release any state that can be recomputed on demand, such as the pixel values for a color gradient or the editor state for a TextMorph. This method may be called to save space when a morph becomes inaccessible. Implementations of this method should do 'super releaseCachedState'."
	self borderStyle releaseCachedState. 
!

----- Method: Morph>>rememberedColor (in category 'accessing') -----
rememberedColor
	"Answer a rememberedColor, or nil if none"

	^ self valueOfProperty: #rememberedColor ifAbsent: [nil]!

----- Method: Morph>>rememberedColor: (in category 'accessing') -----
rememberedColor: aColor
	"Place aColor in a property so I can retrieve it later.  A tortuous but expedient flow of data"

	^ self setProperty: #rememberedColor toValue: aColor!

----- Method: Morph>>removeAlarm: (in category 'events-alarms') -----
removeAlarm: aSelector
	"Remove the given alarm"
	| scheduler |
	scheduler := self alarmScheduler.
	scheduler ifNotNil:[scheduler removeAlarm: aSelector for: self].!

----- Method: Morph>>removeAlarm:at: (in category 'events-alarms') -----
removeAlarm: aSelector at: scheduledTime
	"Remove the given alarm"
	| scheduler |
	scheduler := self alarmScheduler.
	scheduler ifNotNil:[scheduler removeAlarm: aSelector at: scheduledTime for: self].!

----- Method: Morph>>removeAllButFirstSubmorph (in category 'other') -----
removeAllButFirstSubmorph
	"Remove all of the receiver's submorphs other than the first one."

	self submorphs allButFirst do: [:m | m delete]!

----- Method: Morph>>removeAllMorphs (in category 'submorphs-add/remove') -----
removeAllMorphs
	| oldMorphs myWorld |
	myWorld := self world.
	(fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds].
	submorphs do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
	oldMorphs := submorphs.
	submorphs := EmptyArray.
	oldMorphs do: [ :m | self removedMorph: m ].
	self layoutChanged.
!

----- Method: Morph>>removeAllMorphsIn: (in category 'submorphs-add/remove') -----
removeAllMorphsIn: aCollection
	"greatly speeds up the removal of *lots* of submorphs"
	| set myWorld |
	set := IdentitySet new: aCollection size * 4 // 3.
	aCollection do: [:each | each owner == self ifTrue: [ set add: each]].
	myWorld := self world.
	(fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds].
	set do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil].
	submorphs := submorphs reject: [ :each | set includes: each].
	set do: [ :m | self removedMorph: m ].
	self layoutChanged.
!

----- Method: Morph>>removeDropShadow (in category 'drop shadows') -----
removeDropShadow
	self hasDropShadow ifFalse:[^self].
	self changed.
	self hasDropShadow: false.
	fullBounds ifNotNil:[fullBounds := self privateFullBounds].
	self changed.!

----- Method: Morph>>removeFlexShell (in category 'rotate scale and flex') -----
removeFlexShell
	self isFlexed
		ifTrue: [self owner removeFlexShell]!

----- Method: Morph>>removeHalo (in category 'halos and balloon help') -----
removeHalo
	"remove the surrounding halo (if any)"
	self halo isNil
		ifFalse: [self primaryHand removeHalo]!

----- Method: Morph>>removeLink: (in category 'event handling') -----
removeLink: actionCode
	self eventHandler ifNotNil:
		[self eventHandler on: actionCode send: nil to: nil]!

----- Method: Morph>>removeMorph: (in category 'submorphs-add/remove') -----
removeMorph: aMorph
	"Remove the given morph from my submorphs"
	| aWorld |
	aMorph owner == self ifFalse:[^self].
	aWorld := self world.
	aWorld ifNotNil:[
		aMorph outOfWorld: aWorld.
		self privateInvalidateMorph: aMorph.
	].
	self privateRemove: aMorph.
	aMorph privateOwner: nil.
	self removedMorph: aMorph.
!

----- Method: Morph>>removeMouseUpAction (in category 'debug and other') -----
removeMouseUpAction

	self primaryHand showTemporaryCursor: nil.
	self removeProperty: #mouseUpCodeToRun.
	#(mouseUp mouseEnter mouseLeave mouseDown) do: [ :sym |
		self
			on: sym 
			send: #yourself 
			to: nil.
	]

!

----- Method: Morph>>removeProperty: (in category 'accessing - properties') -----
removeProperty: aSymbol 
	"removes the property named aSymbol if it exists"
	extension ifNil:  [^ self].
	extension removeProperty: aSymbol!

----- Method: Morph>>removedMorph: (in category 'submorphs-add/remove') -----
removedMorph: aMorph
	"Notify the receiver that aMorph was just removed from its children"
!

----- Method: Morph>>renameInternal: (in category 'testing') -----
renameInternal: aName 
	"Change the internal name (because of a conflict) but leave the external name unchanged.  Change Player class name, but do not change the names that appear in tiles.  When coming in from disk, and have name conflict, References will already have the new name. "

	self knownName = aName ifTrue: [^ aName].
	self topRendererOrSelf setNameTo: aName.
	
	"References dictionary already has key aName"

	"If this player has a viewer flap, it will remain present"

	"Tiles in scripts all stay the same"

	"Compiled methods for scripts have been fixed up because the same association was reused"
	
	^ aName!

----- Method: Morph>>renameTo: (in category 'testing') -----
renameTo: aName 
	"Set Player name in costume. Update Viewers. Fix all tiles (old style). fix 
	References. New tiles: recompile, and recreate open scripts. If coming in 
	from disk, and have name conflict, References will already have new 
	name. "

	| aPresenter putInViewer aPasteUp renderer oldKey assoc classes oldName |
	oldName := self knownName.
	(renderer := self topRendererOrSelf) setNameTo: aName.
	putInViewer := false.
	((aPresenter := self presenter) isNil or: [renderer player isNil]) 
		ifFalse: 
			[putInViewer := aPresenter currentlyViewing: renderer player.
			putInViewer ifTrue: [renderer player viewerFlapTab hibernate]].
	"empty it temporarily"
	(aPasteUp := self topPasteUp) 
		ifNotNil: [aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]].
	"Fix References dictionary. See restoreReferences to know why oldKey is  
	already aName, but oldName is the old name."
	oldKey := References keyAtIdentityValue: renderer player ifAbsent: [].
	oldKey ifNotNil: 
			[assoc := References associationAt: oldKey.
			oldKey = aName 
				ifFalse: 
					["normal rename"

					assoc key: (renderer player uniqueNameForReferenceFrom: aName).
					References rehash]].
	putInViewer ifTrue: [aPresenter viewMorph: self].
	"recreate my viewer"
	oldKey ifNil: [^aName].
	"Force strings in tiles to be remade with new name. New tiles only."
	Preferences universalTiles ifFalse: [^aName].
	classes := (self systemNavigation allCallsOn: assoc) 
				collect: [:each | each classSymbol].
	classes asSet 
		do: [:clsName | (Smalltalk at: clsName) replaceSilently: oldName to: aName].
	"replace in text body of all methods. Can be wrong!!"
	"Redo the tiles that are showing. This is also done in caller in 
	unhibernate. "
	aPasteUp ifNotNil: 
			[aPasteUp allTileScriptingElements do: 
					[:mm | 
					"just ScriptEditorMorphs"

					nil.
					(mm isScriptEditorMorph) 
						ifTrue: 
							[((mm playerScripted class compiledMethodAt: mm scriptName) 
								hasLiteral: assoc) 
									ifTrue: 
										[mm
											hibernate;
											unhibernate]]]].
	^aName!

----- Method: Morph>>renderedMorph (in category 'structure') -----
renderedMorph
	"This now  gets overridden by rendering morphs."

	^self!

----- Method: Morph>>repelsMorph:event: (in category 'dropping/grabbing') -----
repelsMorph: aMorph event: ev
	^ false!

----- Method: Morph>>replaceSubmorph:by: (in category 'submorphs-add/remove') -----
replaceSubmorph: oldMorph by: newMorph
	| index itsPosition w |
	oldMorph stopStepping.
	itsPosition := oldMorph referencePositionInWorld.
	index := submorphs indexOf: oldMorph.
	oldMorph privateDelete.
	self privateAddMorph: newMorph atIndex: index.
	newMorph referencePositionInWorld: itsPosition.
	(w := newMorph world) ifNotNil:
		[w startSteppingSubmorphsOf: newMorph]!

----- Method: Morph>>reportableSize (in category 'printing') -----
reportableSize
	"Answer a size worth reporting as the receiver's size in a list view"

	| total |
	total := super reportableSize.
	submorphs do:
		[:m | total := total + m reportableSize].
	^ total!

----- Method: Morph>>representativeNoTallerThan:norWiderThan:thumbnailHeight: (in category 'thumbnail') -----
representativeNoTallerThan: maxHeight norWiderThan: maxWidth thumbnailHeight: thumbnailHeight
	"Return a morph representing the receiver but which is no taller than aHeight.  If the receiver is already small enough, just return it, else return a MorphThumbnail companioned to the receiver, enforcing the maxWidth.  If the receiver personally *demands* thumbnailing, do it even if there is no size-related reason to do it."

	self demandsThumbnailing ifFalse:
		[self permitsThumbnailing ifFalse: [^ self].
		(self fullBounds height <= maxHeight and: [self fullBounds width <= maxWidth]) ifTrue: [^ self]].

	^ MorphThumbnail new extent: maxWidth @ (thumbnailHeight min: self fullBounds height); morphRepresented: self!

----- Method: Morph>>reserveUrl: (in category 'fileIn/out') -----
reserveUrl: urlString
	"Write a dummy object to the server to hold a name and place for this object."

	| dummy ext str |
	dummy := PasteUpMorph new.
	dummy borderWidth: 2.
	dummy setProperty: #initialExtent toValue: (ext := 300 at 100).
	dummy topLeft: 50 at 50; extent: ext.	"reset when comes in"
	str := (TextMorph new) topLeft: dummy topLeft + (10 at 10); 
		extent: dummy width - 15 @ 30.
	dummy addMorph: str.
	str contents: 'This is a place holder only.  Please \find the original page and choose \"send this page to server"' withCRs.
	str extent: dummy width - 15 @ 30.
	dummy saveOnURL: urlString.

	"Claim that url myself"
	self setProperty: #SqueakPage toValue: dummy sqkPage.
	(dummy sqkPage) contentsMorph: self; dirty: true.
	^ self url!

----- Method: Morph>>resetExtension (in category 'accessing - extension') -----
resetExtension
	"reset the extension slot if it is not needed"
	(extension notNil and: [extension isDefault]) ifTrue: [extension := nil] !

----- Method: Morph>>resetForwardDirection (in category 'menus') -----
resetForwardDirection
	self forwardDirection: 0.!

----- Method: Morph>>resetHighlightForDrop (in category 'dropping/grabbing') -----
resetHighlightForDrop
	self highlightForDrop: false!

----- Method: Morph>>residesInPartsBin (in category 'parts bin') -----
residesInPartsBin
	"Answer true if the receiver is, or has some ancestor owner who is, a parts bin"
	^ owner ifNotNil: [owner residesInPartsBin] ifNil: [false]!

----- Method: Morph>>resistsRemoval (in category 'accessing') -----
resistsRemoval
	"Answer whether the receiver is marked as resisting removal"

	^ self hasProperty: #resistsRemoval!

----- Method: Morph>>resistsRemoval: (in category 'accessing') -----
resistsRemoval: aBoolean
	"Set the receiver's resistsRemoval property as indicated"

	aBoolean
		ifTrue:
			[self setProperty: #resistsRemoval toValue: true]
		ifFalse:
			[self removeProperty: #resistsRemoval]!

----- Method: Morph>>resistsRemovalString (in category 'menus') -----
resistsRemovalString
	"Answer the string to be shown in a menu to represent the 
	'resistsRemoval' status"
	^ (self resistsRemoval
		ifTrue: ['<on>']
		ifFalse: ['<off>']), 'resist being deleted' translated!

----- Method: Morph>>resizeFromMenu (in category 'meta-actions') -----
resizeFromMenu
	"Commence an interaction that will resize the receiver"

	self resizeMorph: ActiveEvent!

----- Method: Morph>>resizeMorph: (in category 'meta-actions') -----
resizeMorph: evt
	| handle |
	handle := HandleMorph new forEachPointDo: [:newPoint | 
		self extent: (self griddedPoint: newPoint) - self bounds topLeft].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>resourceJustLoaded (in category 'initialization') -----
resourceJustLoaded
	"In case resource relates to me"
	self releaseCachedState.!

----- Method: Morph>>restoreSuspendedEventHandler (in category 'event handling') -----
restoreSuspendedEventHandler
	| savedHandler |
	(savedHandler := self valueOfProperty: #suspendedEventHandler) ifNotNil:
		[self eventHandler: savedHandler].
	submorphs do: [:m | m restoreSuspendedEventHandler]
!

----- Method: Morph>>resumeAfterDrawError (in category 'debug and other') -----
resumeAfterDrawError

	self changed.
	self removeProperty:#errorOnDraw.
	self changed.!

----- Method: Morph>>resumeAfterStepError (in category 'debug and other') -----
resumeAfterStepError
	"Resume stepping after an error has occured."

	self startStepping. "Will #step"
	self removeProperty:#errorOnStep. "Will remove prop only if #step was okay"
!

----- Method: Morph>>reverseTableCells (in category 'layout-properties') -----
reverseTableCells
	"Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props reverseTableCells].!

----- Method: Morph>>reverseTableCells: (in category 'layout-properties') -----
reverseTableCells: aBool
	"Layout specific. This property describes if the cells should be treated in reverse order of submorphs."
	self assureTableProperties reverseTableCells: aBool.
	self layoutChanged.!

----- Method: Morph>>right (in category 'geometry') -----
right
	" Return the x-coordinate of my right side "
	^ bounds right!

----- Method: Morph>>right: (in category 'geometry') -----
right: aNumber
	" Move me so that my right side is at the x-coordinate aNumber. My extent (width & height) are unchanged "

	self position: ((aNumber - bounds width) @ bounds top)!

----- Method: Morph>>rightCenter (in category 'geometry') -----
rightCenter

	^ bounds rightCenter!

----- Method: Morph>>root (in category 'structure') -----
root
	"Return the root of the composite morph containing the receiver. The owner of the root is either nil, a WorldMorph, or a HandMorph. If the receiver's owner is nil, the root is the receiver itself. This method always returns a morph."

	(owner isNil or: [owner isWorldOrHandMorph]) ifTrue: [^self].
	^owner root!

----- Method: Morph>>rootAt: (in category 'structure') -----
rootAt: location
	"Just return myself, unless I am a WorldWindow.
	If so, then return the appropriate root in that world"

	^ self!

----- Method: Morph>>rootMorphsAt: (in category 'submorphs-accessing') -----
rootMorphsAt: aPoint
	"Return the list of root morphs containing the given point, excluding the receiver.
	ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"
self flag: #arNote. "check this at some point"
	^ self submorphs select:
		[:m | (m fullContainsPoint: aPoint) and: [m isLocked not]]!

----- Method: Morph>>rootMorphsAtGlobal: (in category 'submorphs-accessing') -----
rootMorphsAtGlobal: aPoint
	"Return the list of root morphs containing the given point, excluding the receiver.
	ar 11/8/1999: Moved into morph for an incredibly ugly hack in 3D worlds"

	^ self rootMorphsAt: (self pointFromWorld: aPoint)!

----- Method: Morph>>rotationCenter (in category 'geometry eToy') -----
rotationCenter
	"Return the rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	^self valueOfProperty: #rotationCenter ifAbsent:[0.5 at 0.5]
!

----- Method: Morph>>rotationCenter: (in category 'geometry eToy') -----
rotationCenter: aPointOrNil
	"Set the new rotation center of the receiver. The rotation center defines the relative offset inside the receiver's bounds for locating the reference position."
	aPointOrNil isNil
		ifTrue:[self removeProperty: #rotationCenter]
		ifFalse:[self setProperty: #rotationCenter toValue: aPointOrNil]
!

----- Method: Morph>>rotationDegrees (in category 'rotate scale and flex') -----
rotationDegrees
	"Default implementation."

	^ 0.0
!

----- Method: Morph>>rotationStyle (in category 'e-toy support') -----
rotationStyle
	"Return the 'rotation style' of the receiver"
	^#normal!

----- Method: Morph>>rotationStyle: (in category 'e-toy support') -----
rotationStyle: aSymbol
	"Set the 'rotation style' of the receiver; this is ignored for non-sketches"!

----- Method: Morph>>roundUpStrays (in category 'miscellaneous') -----
roundUpStrays
	self submorphs
		do: [:each | each roundUpStrays]!

----- Method: Morph>>roundedCorners (in category 'rounding') -----
roundedCorners
	"Return a list of those corners to round.

		1-4
		|  |
		2-3

	Returned array contains `codes' of those corners, which should be rounded.

	1 denotes top-left corner
	2 denotes bottom-left corner
	3 denotes bottom-right corner
	4 denotes top-right corner.

	Thus, if this method returned #(2 3) that would mean that bottom (left and right)
	corners would be rounded whereas top (left and right) corners wouldn't be rounded.

	This method returns #(1 2 3 4) and that means that all the corners should be rounded."

	^ #(1 2 3 4)!

----- Method: Morph>>roundedCornersString (in category 'rounding') -----
roundedCornersString
	"Answer the string to put in a menu that will invite the user to 
	switch to the opposite corner-rounding mode"
	^ (self wantsRoundedCorners
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'round corners' translated!

----- Method: Morph>>rubberBandCells (in category 'layout-properties') -----
rubberBandCells
	"Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
	| props |
	props := self layoutProperties.
	^props ifNil:[false] ifNotNil:[props rubberBandCells].!

----- Method: Morph>>rubberBandCells: (in category 'layout-properties') -----
rubberBandCells: aBool
	"Layout specific. This property describes if a parent that is #shrinkWrapped around its children should ignore any #spaceFill children. E.g., when #rubberBandCells is true, the compound layout will always stay at the smallest available size, even though some child may be able to grow."
	self assureTableProperties rubberBandCells: aBool.
	self layoutChanged.!

----- Method: Morph>>saveAsPrototype (in category 'meta-actions') -----
saveAsPrototype
	(UIManager default confirm: 'Make this morph the prototype for ', self class printString, '?')
		ifFalse: [^ self].
	self class prototype: self.
!

----- Method: Morph>>saveAsResource (in category 'fileIn/out') -----
saveAsResource

	| pathName |
	(self hasProperty: #resourceFilePath) ifFalse: [^ self].
	pathName := self valueOfProperty: #resourceFilePath.
	(pathName asLowercase endsWith: '.morph') ifFalse:
		[^ self error: 'Can only update morphic resources'].
	(FileStream newFileNamed: pathName) fileOutClass: nil andObject: self.!

----- Method: Morph>>saveDocPane (in category 'fileIn/out') -----
saveDocPane

	Smalltalk at: #DocLibrary ifPresent:[:dl| dl external saveDocCheck: self]!

----- Method: Morph>>saveOnFile (in category 'fileIn/out') -----
saveOnFile
	"Ask the user for a filename and save myself on a SmartReferenceStream file.  Writes out the version and class structure.  The file is fileIn-able.  UniClasses will be filed out."

	| aFileName fileStream ok |
	aFileName := ('my {1}' translated format: {self class name}) asFileName.	"do better?"
	aFileName := UIManager default request: 'File name? (".morph" will be added to end)' translated 
			initialAnswer: aFileName.
	aFileName isEmpty ifTrue: [^ Beeper beep].
	self allMorphsDo: [:m | m prepareToBeSaved].

	ok := aFileName endsWith: '.morph'.	"don't double them"
	ok := ok | (aFileName endsWith: '.sp').
	ok ifFalse: [aFileName := aFileName,'.morph'].
	fileStream := FileStream newFileNamed: aFileName asFileName.
	fileStream fileOutClass: nil andObject: self.	"Puts UniClass definitions out anyway"!

----- Method: Morph>>saveOnURL (in category 'fileIn/out') -----
saveOnURL
	"Ask the user for a url and save myself on a SmartReferenceStream file.  Writes out the version and class structure.  The file is fileIn-able.  UniClasses will be filed out."

	| um pg |
	(pg := self saveOnURLbasic) == #cancel ifTrue: [^ self].
	um := URLMorph newForURL: pg url.
	um setURL: pg url page: pg.
	pg isContentsInMemory ifTrue: [pg computeThumbnail].
	um isBookmark: true.
	um removeAllMorphs.
	um color: Color transparent.
	self primaryHand attachMorph: um.!

----- Method: Morph>>saveOnURL: (in category 'fileIn/out') -----
saveOnURL: suggestedUrlString 
	"Save myself on a SmartReferenceStream file.  If I don't already have a url, use the suggested one.  Writes out the version and class structure.  The file is fileIn-able.  UniClasses will be filed out."
	| url pg stamp pol |
	(pg := self valueOfProperty: #SqueakPage)
		ifNil: [ pg := SqueakPage new ]
		ifNotNil:
			[ pg contentsMorph ~~ self ifTrue:
				[ self inform: 'morph''s SqueakPage property is out of date'.
				pg := SqueakPage new ] ].
	(url := pg url) ifNil: [ url := pg urlNoOverwrite: suggestedUrlString ].
	stamp := Utilities authorInitialsPerSe.
	stamp isEmptyOrNil ifTrue: [ stamp := '*' ].
	pg
		saveMorph: self
		author: stamp.
	SqueakPageCache
		atURL: url
		put: pg.
	"setProperty: #SqueakPage"
	(pol := pg policy) ifNil: [ pol := #neverWrite ].
	pg
		 policy: #now ;
		 dirty: true.
	pg write.
	"force the write"
	pg policy: pol.
	^pg!

----- Method: Morph>>saveOnURLbasic (in category 'fileIn/out') -----
saveOnURLbasic
	"Ask the user for a url and save myself on a SmartReferenceStream file.  Writes out the version and class structure.  The file is fileIn-able.  UniClasses will be filed out."

	| url pg stamp pol |
	(pg := self valueOfProperty: #SqueakPage) ifNil: [pg := SqueakPage new]
		ifNotNil: 
			[pg contentsMorph ~~ self 
				ifTrue: 
					[self inform: 'morph''s SqueakPage property is out of date'.
					pg := SqueakPage new]].
	(url := pg url) ifNil: 
			[url := ServerDirectory defaultStemUrl , '1.sp'.	"A new legal place"
			url := UIManager default 
						request: 'url of a place to store this object.
Must begin with file:// or ftp://'
						initialAnswer: url.
			url isEmpty ifTrue: [^#cancel]].
	stamp := Utilities authorInitialsPerSe.
	stamp isEmptyOrNil ifTrue: [ stamp := '*' ].
	pg saveMorph: self author: stamp.
	SqueakPageCache atURL: url put: pg.	"setProperty: #SqueakPage"
	(pol := pg policy) ifNil: [pol := #neverWrite].
	pg
		policy: #now;
		dirty: true.
	pg write.	"force the write"
	pg policy: pol.
	^pg!

----- Method: Morph>>scale: (in category 'geometry eToy') -----
scale: newScale
	"Backstop for morphs that don't have to do something special to set their scale"
!

----- Method: Morph>>scaleFactor (in category 'accessing') -----
scaleFactor
	^self valueOfProperty: #scaleFactor ifAbsent: [ 1.0 ]
!

----- Method: Morph>>scaleFactor: (in category 'geometry eToy') -----
scaleFactor: newScale 
	"Backstop for morphs that don't have to do something special to set their 
	scale "
	| toBeScaled |
	toBeScaled := self.
	newScale = 1.0
		ifTrue: [(self heading isZero
					and: [self isFlexMorph])
				ifTrue: [toBeScaled := self removeFlexShell]]
		ifFalse: [self isFlexMorph
				ifFalse: [toBeScaled := self addFlexShellIfNecessary]].

	toBeScaled scale: newScale.

	toBeScaled == self ifTrue: [
		newScale = 1.0
			ifTrue: [ self removeProperty: #scaleFactor ]
			ifFalse: [ self setProperty: #scaleFactor toValue: newScale ]]!

----- Method: Morph>>screenLocation (in category 'geometry') -----
screenLocation
	"For compatibility only"

	^ self fullBounds origin!

----- Method: Morph>>screenRectangle (in category 'geometry') -----
screenRectangle
	"For compatibility only"

	^ self fullBounds!

----- Method: Morph>>selectedObject (in category 'selected object') -----
selectedObject
	"answer the selected object for the hand or nil is none"
	^ self primaryHand selectedObject!

----- Method: Morph>>separateDragAndDrop (in category 'dropping/grabbing') -----
separateDragAndDrop
	"Conversion only. Separate the old #dragNDropEnabled into #dragEnabled and #dropEnabled and remove the old property."
	| dnd |
	(self hasProperty: #dragNDropEnabled) ifFalse:[^self].
	dnd := (self valueOfProperty: #dragNDropEnabled) == true.
	self dragEnabled: dnd.
	self dropEnabled: dnd.
	self removeProperty: #dragNDropEnabled.
!

----- Method: Morph>>setArrowheads (in category 'menus') -----
setArrowheads
	"Let the user edit the size of arrowheads for this object"

	| aParameter result  |
	aParameter := self renderedMorph valueOfProperty:  #arrowSpec ifAbsent:
		[Preferences parameterAt: #arrowSpec ifAbsent: [5 @ 4]].
	result := Morph obtainArrowheadFor: 'Head size for arrowheads: ' translated defaultValue: aParameter asString.
	result ifNotNil:
			[self renderedMorph  setProperty: #arrowSpec toValue: result]
		ifNil:
			[Beeper beep]!

----- Method: Morph>>setAsActionInButtonProperties: (in category 'e-toy support') -----
setAsActionInButtonProperties: buttonProperties

	^false	"means I don't know how to be set as a button action"!

----- Method: Morph>>setBalloonText: (in category 'halos and balloon help') -----
setBalloonText: stringOrText
	"Set receiver's balloon help text. Pass nil to remove the help."

	self setBalloonText: stringOrText maxLineLength: Preferences maxBalloonHelpLineLength!

----- Method: Morph>>setBalloonText:maxLineLength: (in category 'halos and balloon help') -----
setBalloonText: stringOrText maxLineLength: aLength 
	"Set receiver's balloon help text. Pass nil to remove the help."
	(extension isNil and: [stringOrText isNil]) ifTrue: [^ self].
	self assureExtension balloonText: 
		(stringOrText ifNotNil: [stringOrText asString withNoLineLongerThan: aLength])!

----- Method: Morph>>setBorderStyle: (in category 'accessing') -----
setBorderStyle: aSymbol
	"Set the border style of my costume"

	| aStyle |
	aStyle := self borderStyleForSymbol: aSymbol.
	aStyle ifNil: [^ self].
	(self canDrawBorder: aStyle)
		ifTrue:
			[self borderStyle: aStyle]!

----- Method: Morph>>setCenteredBalloonText: (in category 'halos and balloon help') -----
setCenteredBalloonText: aString
	self setBalloonText: aString.
	self setProperty: #helpAtCenter toValue: true!

----- Method: Morph>>setConstrainedPosition:hangOut: (in category 'geometry') -----
setConstrainedPosition: aPoint hangOut: partiallyOutside
	"Change the position of this morph and and all of its submorphs to aPoint, but don't let me go outside my owner's bounds.  Let me go within two pixels of completely outside if partiallyOutside is true."

	| trialRect delta boundingMorph bRect |
	owner ifNil:[^self].
	trialRect := aPoint extent: self bounds extent.
	boundingMorph := self topRendererOrSelf owner.
	delta := boundingMorph
			ifNil:    [0 at 0]
			ifNotNil: [
				bRect := partiallyOutside 
					ifTrue: [boundingMorph bounds insetBy: 
								self extent negated + boundingMorph borderWidth + (2 at 2)]
					ifFalse: [boundingMorph bounds].
				trialRect amountToTranslateWithin: bRect].
	self position: aPoint + delta.
	self layoutChanged  "So that, eg, surrounding text will readjust"
!

----- Method: Morph>>setDirectionFrom: (in category 'geometry eToy') -----
setDirectionFrom: aPoint
	| delta degrees |
	delta := (self transformFromWorld globalPointToLocal: aPoint) - self referencePosition.
	degrees := delta degrees + 90.0.
	self forwardDirection: (degrees \\ 360) rounded.
!

----- Method: Morph>>setExtentFromHalo: (in category 'miscellaneous') -----
setExtentFromHalo: anExtent
	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed"

	self extent: anExtent!

----- Method: Morph>>setFlexExtentFromHalo: (in category 'miscellaneous') -----
setFlexExtentFromHalo: anExtent
	"The user has dragged the grow box such that the receiver's extent would be anExtent.  Do what's needed.  Set the extent of the top renderer as indicated."

	self addFlexShellIfNecessary.
	self topRendererOrSelf extent: anExtent!

----- Method: Morph>>setIndexInOwner: (in category 'geometry eToy') -----
setIndexInOwner: anInteger
	"Answer which position the receiver holds in its owner's hierarchy"

	"There is some concern about submorphs that aren't really to be counted, such as a background morph of a playfield."
	| container topRenderer indexToUse |
	container := (topRenderer := self topRendererOrSelf) owner.
	indexToUse := (anInteger min: container submorphCount) max: 1.
	container addMorph: topRenderer asElementNumber: indexToUse!

----- Method: Morph>>setNamePropertyTo: (in category 'naming') -----
setNamePropertyTo: aName 
	"change the receiver's externalName"
	self assureExtension externalName: aName!

----- Method: Morph>>setNameTo: (in category 'naming') -----
setNameTo: aName 
	| nameToUse nameString |
	nameToUse := aName ifNotNil: 
					[(nameString := aName asString) notEmpty ifTrue: [nameString] ifFalse: ['*']].
	self setNamePropertyTo: nameToUse	"no Texts here!!"!

----- Method: Morph>>setNumericValue: (in category 'e-toy support') -----
setNumericValue: aValue
	"Set the receiver's contents to reflect the given numeric value.  Only certain kinds of morphs know what to do with this, the rest, for now, stash the number in a property, where it may not be visible but at least it won't be lost, and can be retrieved by the companion getter.  This code is never reached under normal circumstances, because the #numericValue slot is not shown in Viewers for most kinds of morphs, and those kinds of morphs that do show it also reimplement this method.  However, this code *could* be reached via a user script which sends #setNumericValue: but whose receiver has been changed, via tile-scripting drag and drop for example, to one that doesn't directly handle numbers"

	ScriptingSystem informScriptingUser: 'an unusual setNumericValue: call was made'.
	self renderedMorph setProperty: #numericValue toValue: aValue
!

----- Method: Morph>>setProperties: (in category 'accessing - properties') -----
setProperties: aList
	"Set many properties at once from a list of prop, value, prop, value"

	1 to: aList size by: 2 do: [:ii |
		self setProperty: (aList at: ii) toValue: (aList at: ii+1)].!

----- Method: Morph>>setProperty:toValue: (in category 'accessing - properties') -----
setProperty: aSymbol toValue: anObject 
	"change the receiver's property named aSymbol to anObject"
	anObject ifNil: [^ self removeProperty: aSymbol].
	self assureExtension setProperty: aSymbol toValue: anObject!

----- Method: Morph>>setRotationCenter (in category 'menus') -----
setRotationCenter
	| p |
	self world displayWorld.
	p := Cursor crossHair showWhile:
		[Sensor waitButton].
	Sensor waitNoButton.
	self setRotationCenterFrom: (self transformFromWorld globalPointToLocal: p).

!

----- Method: Morph>>setRotationCenterFrom: (in category 'menus') -----
setRotationCenterFrom: aPoint
	self rotationCenter: (aPoint - self bounds origin) / self bounds extent asFloatPoint.!

----- Method: Morph>>setShadowOffset: (in category 'drop shadows') -----
setShadowOffset: evt
	| handle |
	handle := HandleMorph new forEachPointDo:
		[:newPoint | self shadowPoint: newPoint].
	evt hand attachMorph: handle.
	handle startStepping.
!

----- Method: Morph>>setStandardTexture (in category 'e-toy support') -----
setStandardTexture
	| parms |
	parms := self textureParameters.
	self makeGraphPaperGrid: parms first
		background: parms second
		line: parms third!

----- Method: Morph>>setToAdhereToEdge: (in category 'menus') -----
setToAdhereToEdge: anEdge
	anEdge ifNil: [^ self].
	anEdge == #none ifTrue: [^ self removeProperty: #edgeToAdhereTo].
	self setProperty: #edgeToAdhereTo toValue: anEdge.
!

----- Method: Morph>>shadowColor (in category 'drop shadows') -----
shadowColor
	^self valueOfProperty: #shadowColor ifAbsent:[Color black]!

----- Method: Morph>>shadowColor: (in category 'drop shadows') -----
shadowColor: aColor
	self shadowColor = aColor ifFalse:[self changed].
	self setProperty: #shadowColor toValue: aColor.!

----- Method: Morph>>shadowForm (in category 'drawing') -----
shadowForm
	"Return a form representing the 'shadow' of the receiver - e.g., all pixels that are occupied by the receiver are one, all others are zero."
	| canvas |
	canvas := (Display defaultCanvasClass extent: self fullBounds extent depth: 1)
				asShadowDrawingCanvas: Color black. "Color black represents one for 1bpp"
	canvas translateBy: bounds topLeft negated
		during:[:tempCanvas| tempCanvas fullDrawMorph: self].
	^ canvas form offset: bounds topLeft
!

----- Method: Morph>>shadowOffset (in category 'drop shadows') -----
shadowOffset
	"Return the current shadow offset"
	^self valueOfProperty: #shadowOffset ifAbsent:[0 at 0]!

----- Method: Morph>>shadowOffset: (in category 'drop shadows') -----
shadowOffset: aPoint
	"Set the current shadow offset"
	(aPoint isNil or:[(aPoint x isZero) & (aPoint y isZero)])
		ifTrue:[self removeProperty: #shadowOffset]
		ifFalse:[self setProperty: #shadowOffset toValue: aPoint].!

----- Method: Morph>>shadowPoint: (in category 'drop shadows') -----
shadowPoint: newPoint
	self changed.
	self shadowOffset: newPoint - self center // 5.
	fullBounds ifNotNil:[fullBounds := self privateFullBounds].
	self changed.!

----- Method: Morph>>shiftSubmorphsOtherThan:by: (in category 'geometry') -----
shiftSubmorphsOtherThan: listNotToShift by: delta
	| rejectList |
	rejectList := listNotToShift ifNil: [OrderedCollection new].
	(submorphs copyWithoutAll: rejectList) do:
		[:m | m position: (m position + delta)]!

----- Method: Morph>>shouldDropOnMouseUp (in category 'testing') -----
shouldDropOnMouseUp
	| former |
	former := self formerPosition ifNil:[^false].
	^(former dist: self position) > 10!

----- Method: Morph>>shouldGetStepsFrom: (in category 'WiW support') -----
shouldGetStepsFrom: aWorld
	^self world == aWorld!

----- Method: Morph>>shouldRememberCostumes (in category 'player') -----
shouldRememberCostumes
	^true!

----- Method: Morph>>show (in category 'drawing') -----
show
	"Make sure this morph is on-stage."
	self visible ifFalse: [self visible: true.  self changed]!

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

----- Method: Morph>>showBalloon: (in category 'halos and balloon help') -----
showBalloon: msgString
	"Pop up a balloon containing the given string,
	first removing any existing BalloonMorphs in the world."
	| w |
	self showBalloon: msgString hand: ((w := self world) ifNotNil:[w activeHand]).!

----- Method: Morph>>showBalloon:hand: (in category 'halos and balloon help') -----
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.!

----- Method: Morph>>showHiders (in category 'meta-actions') -----
showHiders
	self allMorphsDo:[:m | m show]!

----- Method: Morph>>shuffleSubmorphs (in category 'submorphs-accessing') -----
shuffleSubmorphs
	"Randomly shuffle the order of my submorphs.  Don't call this method lightly!!"

	| bg |
	self invalidRect: self fullBounds.
	(submorphs notEmpty and: [submorphs last mustBeBackmost]) 
		ifTrue: 
			[bg := submorphs last.
			bg privateDelete].
	submorphs := submorphs shuffled.
	bg ifNotNil: [self addMorphBack: bg].
	self layoutChanged!

----- Method: Morph>>sightTargets: (in category 'meta-actions') -----
sightTargets: event 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	| bullseye candidates choice |
	owner ifNil: [^ #()].
	bullseye := Point fromUserWithCursor: Cursor target.
	candidates := self potentialTargetsAt: bullseye.
	choice := UIManager default 
		chooseFrom: (candidates collect:[:m| m knownName ifNil:[m class name]])
		values: candidates.
	choice ifNotNil:[self target: choice].!

----- Method: Morph>>sightWorldTargets: (in category 'meta-actions') -----
sightWorldTargets: event 
	"Return the potential targets for the receiver.  
	This is derived from Morph>>potentialEmbeddingTargets."
	| bullseye myWorld candidates choice |
	myWorld := self world ifNil: [^ #()].
	bullseye := Point fromUserWithCursor: Cursor target.
	candidates := myWorld morphsAt: bullseye.
	choice := UIManager default 
		chooseFrom: (candidates collect:[:m| m knownName ifNil:[m class name]])
		values: candidates.
	choice ifNotNil:[self target: choice].!

----- Method: Morph>>simplySetVisible: (in category 'geometry eToy') -----
simplySetVisible: aBoolean
	"Set the receiver's visibility property.  This mild circumlocution is because my TransfomationMorph #visible: method would also set the visibility flag of my flexee, which in this case is pointless because it's the flexee that calls this.
	This appears in morph as a backstop for morphs that don't inherit from TFMorph"

	self visible: aBoolean!

----- Method: Morph>>slideBackToFormerSituation: (in category 'dropping/grabbing') -----
slideBackToFormerSituation: evt 
	| slideForm formerOwner formerPosition aWorld startPoint endPoint trans |
	formerOwner := self formerOwner.
	formerPosition := self formerPosition.
	aWorld := evt hand world.
	trans := formerOwner transformFromWorld.
	slideForm := trans isPureTranslation 
				ifTrue: [self imageForm offset: 0 @ 0]
				ifFalse: 
					[((TransformationMorph new asFlexOf: self) transform: trans) imageForm 
						offset: 0 @ 0]. 
	startPoint := evt hand fullBounds origin.
	endPoint := trans localPointToGlobal: formerPosition.
	owner removeMorph: self.
	aWorld displayWorld.
	slideForm 
		slideFrom: startPoint
		to: endPoint
		nSteps: 12
		delay: 15.
	formerOwner addMorph: self.
	self position: formerPosition.
	self justDroppedInto: formerOwner event: evt!

----- Method: Morph>>slideToTrash: (in category 'dropping/grabbing') -----
slideToTrash: evt
	"Perhaps slide the receiver across the screen to a trash can and make it disappear into it.  In any case, remove the receiver from the screen."

	| aForm trash startPoint endPoint morphToSlide |
	((self renderedMorph == Utilities scrapsBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue:
		[self dismissMorph.  ^ self].
	Preferences slideDismissalsToTrash ifTrue:
		[morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100.
		aForm := morphToSlide imageForm offset: (0 at 0).
		trash := ActiveWorld
			findDeepSubmorphThat:
				[:aMorph | (aMorph isKindOf: TrashCanMorph) and:
					[aMorph topRendererOrSelf owner == ActiveWorld]]
			ifAbsent:
				[trash := TrashCanMorph new.
				trash bottomLeft: ActiveWorld bottomLeft - (-10 at 10).
				trash openInWorld.
				trash].
		endPoint := trash fullBoundsInWorld center.
		startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)].
	self dismissMorph.
	ActiveWorld displayWorld.
	Preferences slideDismissalsToTrash ifTrue:
		[aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
	Utilities addToTrash: self!

----- Method: Morph>>snapToEdgeIfAppropriate (in category 'menus') -----
snapToEdgeIfAppropriate
	| edgeSymbol oldBounds aWorld |
	(edgeSymbol := self valueOfProperty: #edgeToAdhereTo) ifNotNil:
		[oldBounds := bounds.
		self adhereToEdge: edgeSymbol.
		bounds ~= oldBounds ifTrue: [(aWorld := self world) ifNotNil: [aWorld viewBox ifNotNil:
			[aWorld displayWorld]]]]!

----- Method: Morph>>spaceFillWeight (in category 'layout-properties') -----
spaceFillWeight
	"Layout specific. This property describes the relative weight that 
	should be given to the receiver when extra space is distributed 
	between different #spaceFill cells."

	^ self
		valueOfProperty: #spaceFillWeight
		ifAbsent: [1]!

----- Method: Morph>>spaceFillWeight: (in category 'layout-properties') -----
spaceFillWeight: aNumber
	"Layout specific. This property describes the relative weight that should be given to the receiver when extra space is distributed between different #spaceFill cells."
	aNumber = 1
		ifTrue:[self removeProperty: #spaceFillWeight]
		ifFalse:[self setProperty: #spaceFillWeight toValue: aNumber].
	self layoutChanged.!

----- Method: Morph>>specialNameInModel (in category 'naming') -----
specialNameInModel
	"Return the name for this morph in the underlying model or nil."

	"Not an easy problem.  For now, take the first part of the mouseDownSelector symbol in my eventHandler (fillBrushMouseUp:morph: gives 'fillBrush').  5/26/97 tk"

	| hh |
	(self isMorphicModel) 
		ifTrue: [^self slotName]
		ifFalse: 
			[self eventHandler ifNotNil: 
					[self eventHandler mouseDownSelector ifNotNil: 
							[hh := self eventHandler mouseDownSelector indexOfSubCollection: 'Mouse'
										startingAt: 1.
							hh > 0 
								ifTrue: [^self eventHandler mouseDownSelector copyFrom: 1 to: hh - 1]].
					self eventHandler mouseUpSelector ifNotNil: 
							[hh := self eventHandler mouseUpSelector indexOfSubCollection: 'Mouse'
										startingAt: 1.
							hh > 0 ifTrue: [^self eventHandler mouseUpSelector copyFrom: 1 to: hh - 1]]]].

	"	(self eventHandler mouseDownRecipient respondsTo: #nameFor:) ifTrue: [
					^ self eventHandler mouseDownRecipient nameFor: self]]].	"
	"myModel := self findA: MorphicModel.
			myModel ifNotNil: [^ myModel slotName]"
	^self world specialNameInModelFor: self!

----- Method: Morph>>sqkPage (in category 'accessing') -----
sqkPage
	^ self valueOfProperty: #SqueakPage!

----- Method: Morph>>standardPalette (in category 'initialization') -----
standardPalette
	"Answer a standard palette forced by some level of enclosing presenter, or nil if none"
	| pal aPresenter itsOwner |
	(aPresenter := self presenter) ifNil: [^ nil].
	^ (pal := aPresenter ownStandardPalette)
		ifNotNil: [pal]
		ifNil:	[(itsOwner := aPresenter associatedMorph owner)
					ifNotNil:
						[itsOwner standardPalette]
					ifNil:
						[nil]]!

----- Method: Morph>>start (in category 'stepping and presenter') -----
start
	"Start running my script. For ordinary morphs, this means start stepping."

	self startStepping.
!

----- Method: Morph>>startDrag: (in category 'event handling') -----
startDrag: evt
	"Handle a double-click event. This message is only sent to clients that request it by sending #waitForClicksOrDrag:event: to the initiating hand in their mouseDown: method. This default implementation does nothing."

	self eventHandler ifNotNil:
		[self eventHandler startDrag: evt fromMorph: self].!

----- Method: Morph>>startDrag:with: (in category 'dropping/grabbing') -----
startDrag: anItem with: anObject
	self currentHand attachMorph: anObject!

----- Method: Morph>>startStepping (in category 'stepping and presenter') -----
startStepping
	"Start getting sent the 'step' message."
	self startStepping: #stepAt: at: Time millisecondClockValue arguments: nil stepTime: nil.!

----- Method: Morph>>startStepping:at:arguments:stepTime: (in category 'stepping and presenter') -----
startStepping: aSelector at: scheduledTime arguments: args stepTime: stepTime
	"Start stepping the receiver"
	| w |
	w := self world.
	w ifNotNil: [
		w startStepping: self at: scheduledTime selector: aSelector arguments: args stepTime: stepTime.
		self changed].!

----- Method: Morph>>startSteppingIn: (in category 'stepping and presenter') -----
startSteppingIn: aWorld
	"Start getting sent the 'step' message in aWorld"

	self step.  "one to get started!!"
	aWorld ifNotNil: [aWorld startStepping: self].
	self changed!

----- Method: Morph>>startSteppingSelector: (in category 'stepping and presenter') -----
startSteppingSelector: aSelector
	"Start getting sent the 'step' message."
	self startStepping: aSelector at: Time millisecondClockValue arguments: nil stepTime: nil.!

----- Method: Morph>>startWiring (in category 'menu') -----
startWiring
	Smalltalk
		at: #NCAAConnectorMorph
		ifPresent: [:connectorClass | connectorClass newCurvyArrow startWiringFrom: self] !

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

----- Method: Morph>>stepAt: (in category 'stepping and presenter') -----
stepAt: millisecondClockValue
	"Do some periodic activity. Use startStepping/stopStepping to start and stop getting sent this message. The time between steps is specified by this morph's answer to the stepTime message.
	The millisecondClockValue parameter gives the value of the millisecond clock at the moment of dispatch.
	Default is to dispatch to the parameterless step method for the morph, but this protocol makes it possible for some morphs to do differing things depending on the clock value"
	self player ifNotNil:[:p| p stepAt: millisecondClockValue].
	self step
!

----- Method: Morph>>stepTime (in category 'testing') -----
stepTime
	"Answer the desired time between steps in milliseconds. This default implementation requests that the 'step' method be called once every second."

	^ self topRendererOrSelf player ifNotNil: [10] ifNil: [1000]!

----- Method: Morph>>stickinessString (in category 'menus') -----
stickinessString
	"Answer the string to be shown in a menu to represent the  
	stickiness status"
	^ (self isSticky
		ifTrue: ['<yes>']
		ifFalse: ['<no>'])
		, 'resist being picked up' translated!

----- Method: Morph>>sticky: (in category 'accessing') -----
sticky: aBoolean 
	"change the receiver's sticky property"
	extension sticky: aBoolean!

----- Method: Morph>>stop (in category 'stepping and presenter') -----
stop
	"Stop running my script. For ordinary morphs, this means stop stepping."

	self stopStepping.
!

----- Method: Morph>>stopStepping (in category 'stepping and presenter') -----
stopStepping
	"Stop getting sent the 'step' message."

	| w |
	w := self world.
	w ifNotNil: [w stopStepping: self].
!

----- Method: Morph>>stopSteppingSelector: (in category 'stepping and presenter') -----
stopSteppingSelector: aSelector
	"Stop getting sent the given message."
	| w |
	w := self world.
	w ifNotNil: [w stopStepping: self selector: aSelector].
!

----- Method: Morph>>stopSteppingSelfAndSubmorphs (in category 'stepping and presenter') -----
stopSteppingSelfAndSubmorphs
	self allMorphsDo: [:m | m stopStepping]
!

----- Method: Morph>>storeDataOn: (in category 'objects from disk') -----
storeDataOn: aDataStream
	"Let all Morphs be written out.  All owners are weak references.  They only go out if the owner is in the tree being written."
	| cntInstVars cntIndexedVars ti localInstVars |

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

----- Method: Morph>>structureString (in category 'printing') -----
structureString
	"Return a string that showing this morph and all its submorphs in an indented list that reflects its structure."

	| s |
	s := WriteStream on: (String new: 1000).
	self printStructureOn: s indent: 0.
	^ s contents
!

----- Method: Morph>>subclassMorph (in category 'meta-actions') -----
subclassMorph
	"Create a new subclass of this morph's class and make this morph be an instance of it."

	| oldClass newClassName newClass newMorph |
	oldClass := self class.
	newClassName := UIManager default
		request: 'Please give this new class a name'
		initialAnswer: oldClass name.
	newClassName = '' ifTrue: [^ self].
	(Smalltalk includesKey: newClassName)
		ifTrue: [^ self inform: 'Sorry, there is already a class of that name'].

	newClass := oldClass subclass: newClassName asSymbol
		instanceVariableNames: ''
		classVariableNames: ''
		poolDictionaries: ''
		category: oldClass category asString.
	newMorph := self as: newClass.
	self become: newMorph.
!

----- Method: Morph>>submorphAfter (in category 'submorphs-accessing') -----
submorphAfter
	"Return the submorph after (behind) me, or nil"
	| ii |
	owner ifNil: [^ nil].
	^ (ii := owner submorphIndexOf: self) = owner submorphs size 
		ifTrue: [nil]
		ifFalse: [owner submorphs at: ii+1].
	
!

----- Method: Morph>>submorphBefore (in category 'submorphs-accessing') -----
submorphBefore
	"Return the submorph after (behind) me, or nil"
	| ii |
	owner ifNil: [^ nil].
	^ (ii := owner submorphIndexOf: self) = 1 
		ifTrue: [nil]
		ifFalse: [owner submorphs at: ii-1].
	
!

----- Method: Morph>>submorphBounds (in category 'layout') -----
submorphBounds
	"Private. Compute the actual full bounds of the receiver"
	| box |
	submorphs do: [:m | | subBox | 
		(m visible) ifTrue: [
			subBox := m fullBounds.
			box 
				ifNil:[box := subBox copy]
				ifNotNil:[box := box quickMerge: subBox]]].
	box ifNil:[^self bounds]. "e.g., having submorphs but not visible"
	^ box origin asIntegerPoint corner: box corner asIntegerPoint
!

----- Method: Morph>>submorphCount (in category 'submorphs-accessing') -----
submorphCount

	^ submorphs size!

----- Method: Morph>>submorphIndexOf: (in category 'submorphs-add/remove') -----
submorphIndexOf: aMorph
	"Assuming aMorph to be one of my submorphs, answer where it occurs in my submorph list"

	^ submorphs indexOf: aMorph ifAbsent: [nil]!

----- Method: Morph>>submorphNamed: (in category 'submorphs-accessing') -----
submorphNamed: aName
	^ self submorphNamed: aName ifNone: [nil]!

----- Method: Morph>>submorphNamed:ifNone: (in category 'submorphs-accessing') -----
submorphNamed: aName ifNone: aBlock 
	"Find the first submorph with this name, or a button with an action selector of that name"

	
	self submorphs do: [:p | p knownName = aName ifTrue: [^p]].
	self submorphs do: 
			[:button | | sub args | 
			(button respondsTo: #actionSelector) 
				ifTrue: [button actionSelector == aName ifTrue: [^button]].
			((button respondsTo: #arguments) and: [(args := button arguments) notNil]) 
				ifTrue: [(args at: 2 ifAbsent: [nil]) == aName ifTrue: [^button]].
			(button isAlignmentMorph) 
				ifTrue: [(sub := button submorphNamed: aName ifNone: [nil]) ifNotNil: [^sub]]].
	^aBlock value!

----- Method: Morph>>submorphOfClass: (in category 'submorphs-accessing') -----
submorphOfClass: aClass

	^self findA: aClass!

----- Method: Morph>>submorphThat:ifNone: (in category 'submorphs-accessing') -----
submorphThat: block1 ifNone: block2
	^ submorphs detect: [:m | (block1 value: m) == true] ifNone: [block2 value]
	!

----- Method: Morph>>submorphWithProperty: (in category 'submorphs-accessing') -----
submorphWithProperty: aSymbol
	^ submorphs detect: [:aMorph | aMorph hasProperty: aSymbol] ifNone: [nil]!

----- Method: Morph>>submorphs (in category 'submorphs-accessing') -----
submorphs
	"This method returns my actual submorphs collection. Modifying the collection directly could be dangerous; make a copy if you need to alter it."
	^ submorphs !

----- Method: Morph>>submorphsBehind:do: (in category 'submorphs-accessing') -----
submorphsBehind: aMorph do: aBlock
	| behind |
	behind := false.
	submorphs do:
		[:m | m == aMorph ifTrue: [behind := true]
						ifFalse: [behind ifTrue: [aBlock value: m]]].
!

----- Method: Morph>>submorphsDo: (in category 'submorphs-accessing') -----
submorphsDo: aBlock 
	submorphs do: aBlock!

----- Method: Morph>>submorphsInFrontOf:do: (in category 'submorphs-accessing') -----
submorphsInFrontOf: aMorph do: aBlock
	| behind |
	behind := false.
	submorphs do:
		[:m | m == aMorph ifTrue: [behind := true]
						ifFalse: [behind ifFalse: [aBlock value: m]]].
!

----- Method: Morph>>submorphsReverseDo: (in category 'submorphs-accessing') -----
submorphsReverseDo: aBlock

	submorphs reverseDo: aBlock.!

----- Method: Morph>>submorphsSatisfying: (in category 'submorphs-accessing') -----
submorphsSatisfying: aBlock
	^ submorphs select: [:m | (aBlock value: m) == true]!

----- Method: Morph>>suspendEventHandler (in category 'event handling') -----
suspendEventHandler
	self eventHandler ifNotNil:
		[self setProperty: #suspendedEventHandler toValue: self eventHandler.
		self eventHandler: nil].
	submorphs do: [:m | m suspendEventHandler].  "All those rectangles"!

----- Method: Morph>>tabAmongFields (in category 'event handling') -----
tabAmongFields
	^ Preferences tabAmongFields
		or: [self hasProperty: #tabAmongFields] !

----- Method: Morph>>target: (in category 'accessing-backstop') -----
target: aMorph
"Morphs with targets will override. This backstop does nothing."
"This is here because targeting meta-actions are taken at morph level. 
Do not remove."!

----- Method: Morph>>targetFromMenu: (in category 'meta-actions') -----
targetFromMenu: aMenu 
	"Some other morph become target of the receiver"
	| newTarget |
	
	newTarget := aMenu startUpWithCaption: self externalName , ' targets...'.
	newTarget
		ifNil: [^ self].
	self target: newTarget!

----- Method: Morph>>targetWith: (in category 'meta-actions') -----
targetWith: evt
	"Some other morph become target of the receiver"
	|  morphs newTarget |
	morphs := self potentialTargets.
	newTarget := UIManager default
		chooseFrom: (morphs collect: [:m | m knownName ifNil:[m class name asString]])
		values: morphs
		title:  self externalName, ' targets...'.
	newTarget ifNil:[^self].
	self target: newTarget.!

----- Method: Morph>>tempCommand (in category 'debug and other') -----
tempCommand
	"Generic backstop.  If you care to, you can comment out what's below here, and substitute your own code, though the intention of design of the feature is that you leave this method as it is, and instead reimplement tempCommand in the class of whatever individual morph you care to.  In any case, once you have your own #tempCommand in place, you will then be able to invoke it from the standard debugging menus."

	self inform: 'Before calling tempCommand, you
should first give it a definition.  To
do this, choose "define tempCommand"
from the debug menu.' translated!

----- Method: Morph>>textAnchorType (in category 'text-anchor') -----
textAnchorType
	^self valueOfProperty: #textAnchorType ifAbsent:[#document]!

----- Method: Morph>>textAnchorType: (in category 'text-anchor') -----
textAnchorType: aSymbol
	aSymbol == #document
		ifTrue:[^self removeProperty: #textAnchorType]
		ifFalse:[^self setProperty: #textAnchorType toValue: aSymbol].!

----- Method: Morph>>textToPaste (in category 'printing') -----
textToPaste
	"If the receiver has text to offer pasting, answer it, else answer nil"

	^ nil!

----- Method: Morph>>textureParameters (in category 'e-toy support') -----
textureParameters
	"Answer a triplet giving the preferred grid size, background color, and line color.  The choices here are as suggested by Alan, 9/13/97"

	^ Array with: 16 with: Color lightYellow with: Color lightGreen lighter lighter!

----- Method: Morph>>toggleCornerRounding (in category 'rounding') -----
toggleCornerRounding
	self cornerStyle == #rounded
		ifTrue: [self cornerStyle: #square]
		ifFalse: [self cornerStyle: #rounded].
	self changed!

----- Method: Morph>>toggleDragNDrop (in category 'dropping/grabbing') -----
toggleDragNDrop
	"Toggle this morph's ability to add and remove morphs via drag-n-drop."

		self enableDragNDrop: self dragNDropEnabled not.
!

----- Method: Morph>>toggleDropShadow (in category 'drop shadows') -----
toggleDropShadow
	self hasDropShadow
		ifTrue:[self removeDropShadow]
		ifFalse:[self addDropShadow].!

----- Method: Morph>>toggleLocked (in category 'accessing') -----
toggleLocked
	
	self lock: self isLocked not!

----- Method: Morph>>toggleResistsRemoval (in category 'accessing') -----
toggleResistsRemoval
	"Toggle the resistsRemoval property"

	self resistsRemoval
		ifTrue:
			[self removeProperty: #resistsRemoval]
		ifFalse:
			[self setProperty: #resistsRemoval toValue: true]!

----- Method: Morph>>toggleStickiness (in category 'accessing') -----
toggleStickiness
	"togle the receiver's Stickiness"
	extension ifNil: [^ self beSticky].
	extension sticky: extension sticky not!

----- Method: Morph>>top (in category 'geometry') -----
top
	" Return the y-coordinate of my top side "

	^ bounds top!

----- Method: Morph>>top: (in category 'geometry') -----
top: aNumber
	" Move me so that my top is at the y-coordinate aNumber. My extent (width & height) are unchanged "

	self position: (bounds left @ aNumber)!

----- Method: Morph>>topCenter (in category 'geometry') -----
topCenter

	^ bounds topCenter!

----- Method: Morph>>topLeft (in category 'geometry') -----
topLeft

	^ bounds topLeft!

----- Method: Morph>>topLeft: (in category 'geometry') -----
topLeft: aPoint
	" Move me so that my top left corner is at aPoint. My extent (width & height) are unchanged "

	self position: aPoint
!

----- Method: Morph>>topPasteUp (in category 'structure') -----
topPasteUp
	"If the receiver is in a world, return that; otherwise return the outermost pasteup morph"
	^ self outermostMorphThat: [:m | m isKindOf: PasteUpMorph]!

----- Method: Morph>>topRendererOrSelf (in category 'structure') -----
topRendererOrSelf
	"Answer the topmost renderer for this morph, or this morph itself if it has no renderer. See the comment in Morph>isRenderer."

	| top topsOwner |
	owner ifNil: [^self].
	self isWorldMorph ifTrue: [^self].	"ignore scaling of this world"
	top := self.
	topsOwner := top owner.
	[topsOwner notNil and: [topsOwner isRenderer]] whileTrue: 
			[top := topsOwner.
			topsOwner := top owner].
	^top!

----- Method: Morph>>topRight (in category 'geometry') -----
topRight

	^ bounds topRight!

----- Method: Morph>>topRight: (in category 'geometry') -----
topRight: aPoint
	" Move me so that my top right corner is at aPoint. My extent (width & height) are unchanged "

	self position: ((aPoint x - bounds width) @ (aPoint y))
!

----- Method: Morph>>touchesColor: (in category 'geometry eToy') -----
touchesColor: soughtColor 
	"Return true if any of my pixels overlap pixels of soughtColor."

	"Make a shadow mask with black in my shape, white elsewhere"

	| map patchBelowMe shadowForm tfm morphAsFlexed pasteUp |
	pasteUp := self world ifNil: [ ^false ].

	tfm := self transformFrom: pasteUp.
	morphAsFlexed := tfm isIdentity 
				ifTrue: [self]
				ifFalse: [TransformationMorph new flexing: self clone byTransformation: tfm].
	shadowForm := morphAsFlexed shadowForm offset: 0 @ 0.

	"get an image of the world below me"
	patchBelowMe := (pasteUp 
				patchAt: morphAsFlexed fullBounds
				without: self
				andNothingAbove: false) offset: 0 @ 0.
	"
shadowForm displayAt: 0 at 0.
patchBelowMe displayAt: 100 at 0.
"
	"intersect world pixels of the color we're looking for with our shape."
	"ensure a maximum 16-bit map"
	map := Bitmap new: (1 bitShift: (patchBelowMe depth - 1 min: 15)).
	map at: (soughtColor indexInMap: map) put: 1.
	shadowForm 
		copyBits: patchBelowMe boundingBox
		from: patchBelowMe
		at: 0 @ 0
		clippingBox: patchBelowMe boundingBox
		rule: Form and
		fillColor: nil
		map: map.
	"
shadowForm displayAt: 200 at 0.
"
	^(shadowForm tallyPixelValues second) > 0!

----- Method: Morph>>transferHalo:from: (in category 'halos and balloon help') -----
transferHalo: event from: formerHaloOwner
	"Progressively transfer the halo to the next likely recipient"
	| localEvt w target |

	self flag: #workAround. "For halo's distinction between 'target' and 'innerTarget' we need to bypass any renderers."
	(formerHaloOwner == self and:[self isRenderer and:[self wantsHaloFromClick not]]) ifTrue:[
		event shiftPressed ifTrue:[
			target := owner.
			localEvt := event transformedBy: (self transformedFrom: owner).
		] ifFalse:[
			target := self renderedMorph.
			localEvt := event transformedBy: (target transformedFrom: self).
		].
		^target transferHalo: localEvt from: target].

"	formerHaloOwner == self ifTrue:[^ self removeHalo]."

	"Never transfer halo to top-most world"
	(self isWorldMorph and:[owner isNil]) ifFalse:[
		(self wantsHaloFromClick and:[formerHaloOwner ~~ self]) 
			ifTrue:[^self addHalo: event from: formerHaloOwner]].

	event shiftPressed ifTrue:[
		"Pass it outwards"
		owner ifNotNil:[^owner transferHalo: event from: formerHaloOwner].
		"We're at the top level; throw the event back in to find recipient"
		formerHaloOwner removeHalo.
		^self processEvent: event copy resetHandlerFields.
	].
	self submorphsDo:[:m|
		localEvt := event transformedBy: (m transformedFrom: self).
		(m fullContainsPoint: localEvt position) 
			ifTrue:[^m transferHalo: event from: formerHaloOwner].
	].
	"We're at the bottom most level; throw the event back up to the root to find recipient"
	formerHaloOwner removeHalo.

	Preferences maintainHalos ifFalse:[
		(w := self world) ifNil: [ ^self ].
		localEvt := event transformedBy: (self transformedFrom: w) inverseTransformation.
		^w processEvent: localEvt resetHandlerFields.
	].
!

----- Method: Morph>>transferStateToRenderer: (in category 'menus') -----
transferStateToRenderer: aRenderer
	"Transfer knownName, actorState, visible, and player info over to aRenderer, which is being imposed above me as a transformation shell"

	| current |
	(current := self actorStateOrNil) ifNotNil:
		[aRenderer actorState: current.
		self actorState: nil].

	(current := self knownName) ifNotNil:
		[aRenderer setNameTo: current.
		self setNameTo: nil].

	(current := self player) ifNotNil:
		[aRenderer player: current.
		self player rawCostume: aRenderer.
		"NB player is redundantly pointed to in the extension of both the renderer and the rendee; this is regrettable but many years ago occasionally people tried to make that clean but always ran into problems iirc"
		"self player: nil"].

	aRenderer simplySetVisible: self visible



 

		!

----- Method: Morph>>transformFrom: (in category 'event handling') -----
transformFrom: uberMorph 
	"Return a transform to be used to map coordinates in a morph above me into my childrens coordinates, or vice-versa. This is used to support scrolling, scaling, and/or rotation. This default implementation just returns my owner's transform or the identity transform if my owner is nil. 
	Note:  This method cannot be used to map into the receiver's coordinate system!!"

	(self == uberMorph or: [owner isNil]) ifTrue: [^IdentityTransform new].
	^owner transformFrom: uberMorph!

----- Method: Morph>>transformFromOutermostWorld (in category 'event handling') -----
transformFromOutermostWorld
	"Return a transform to map world coordinates into my local coordinates"

	"self isWorldMorph ifTrue: [^ MorphicTransform identity]."
	^ self transformFrom: self outermostWorldMorph!

----- Method: Morph>>transformFromWorld (in category 'event handling') -----
transformFromWorld
	"Return a transform to map world coordinates into my local coordinates"

	^ self transformFrom: nil!

----- Method: Morph>>transformedBy: (in category 'geometry') -----
transformedBy: aTransform
	aTransform isIdentity ifTrue:[^self].
	aTransform isPureTranslation ifTrue:[
		^self position: (aTransform localPointToGlobal: self position).
	].
	^self addFlexShell transformedBy: aTransform!

----- Method: Morph>>transformedFrom: (in category 'events-processing') -----
transformedFrom: uberMorph
	"Return a transform to map coordinates of uberMorph, a morph above me in my owner chain, into the coordinates of MYSELF not any of my children."
	self flag: #arNote. "rename this method"
	owner ifNil:[^IdentityTransform new].
	^ (owner transformFrom: uberMorph)!

----- Method: Morph>>transparentSpacerOfSize: (in category 'geometry eToy') -----
transparentSpacerOfSize: aPoint
	^ (Morph new extent: aPoint) color: Color transparent!

----- Method: Morph>>transportedMorph (in category 'dropping/grabbing') -----
transportedMorph
	^self!

----- Method: Morph>>tryToRenameTo: (in category 'naming') -----
tryToRenameTo: aName
	"A new name has been submited; make sure it's appropriate, and react accordingly.  This circumlocution provides the hook by which the simple renaming of a field can result in a change to variable names in a stack, etc.  There are some problems to worry about here."

	self renameTo: aName.!

----- Method: Morph>>unHighlight (in category 'accessing') -----
unHighlight
	self color: self regularColor!

----- Method: Morph>>uncollapseSketch (in category 'menus') -----
uncollapseSketch

	| uncollapsedVersion w whomToDelete |

	(w := self world) ifNil: [^self].
	uncollapsedVersion := self valueOfProperty: #uncollapsedMorph.
	uncollapsedVersion ifNil: [^self].
	whomToDelete := self valueOfProperty: #collapsedMorphCarrier.
	uncollapsedVersion setProperty: #collapsedPosition toValue: whomToDelete position.

	whomToDelete delete.
	w addMorphFront: uncollapsedVersion.

!

----- Method: Morph>>undoGrabCommand (in category 'dropping/grabbing') -----
undoGrabCommand
	"Return an undo command for grabbing the receiver"

	| cmd |
	owner ifNil:
		[^ nil]. "no owner - no undo"
	^ (cmd := Command new)
		cmdWording: 'move ' translated, self nameForUndoWording;
		undoTarget: self
		selector: #undoMove:redo:owner:bounds:predecessor:
		arguments: {cmd. false. owner. self bounds. (owner morphPreceding: self)};
		yourself!

----- Method: Morph>>undoMove:redo:owner:bounds:predecessor: (in category 'undo') -----
undoMove: cmd redo: redo owner: formerOwner bounds: formerBounds predecessor: formerPredecessor 
	"Handle undo and redo of move commands in morphic"

	self owner ifNil: [^Beeper beep].
	redo 
		ifFalse: 
			["undo sets up the redo state first"

			cmd 
				redoTarget: self
				selector: #undoMove:redo:owner:bounds:predecessor:
				arguments: { 
						cmd.
						true.
						owner.
						bounds.
						owner morphPreceding: self}].
	formerOwner ifNotNil: 
			[formerPredecessor ifNil: [formerOwner addMorphFront: self]
				ifNotNil: [formerOwner addMorph: self after: formerPredecessor]].
	self bounds: formerBounds.
	(self isSystemWindow) ifTrue: [self activate]!

----- Method: Morph>>unlock (in category 'accessing') -----
unlock
	self lock: false!

----- Method: Morph>>unlockContents (in category 'accessing') -----
unlockContents
	self submorphsDo:
		[:m | m unlock]!

----- Method: Morph>>unlockOneSubpart (in category 'e-toy support') -----
unlockOneSubpart
	| unlockables reply |
	unlockables := self submorphs select:
		[:m | m isLocked].
	unlockables size <= 1 ifTrue: [^ self unlockContents].
	reply := UIManager default
		chooseFrom: (unlockables collect: [:m | m externalName]) 
		values: unlockables
		title:  'Who should be be unlocked?' translated.
	reply isNil ifTrue: [^ self].
	reply unlock!

----- Method: Morph>>updateAllFromResources (in category 'fileIn/out') -----
updateAllFromResources

	self allMorphsDo: [:m | m updateFromResource]!

----- Method: Morph>>updateAllScriptingElements (in category 'naming') -----
updateAllScriptingElements
	"A sledge-hammer sweep from the world down to make sure that all live scripting elements are up to date.  Presently in eclipse, not sent at the moment."

	| aPasteUp |
	(aPasteUp := self topPasteUp) ifNotNil:
		[aPasteUp allTileScriptingElements do: [:m | m bringUpToDate]]!

----- Method: Morph>>updateCachedThumbnail (in category 'e-toy support') -----
updateCachedThumbnail
	"If I have a cached thumbnail, then update it.  Copied up from Dan's original version in PasteUpMorph so it can be used by all morphs."
	| cachedThumbnail |

	(cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
		[(cachedThumbnail respondsTo: #computeThumbnail) 
			ifTrue: [cachedThumbnail computeThumbnail]
			ifFalse: [self removeProperty: #computeThumbnail]].
		"Test and removal are because the thumbnail is being replaced by another Morph.  We don't know why.  Need to fix that at the source."!

----- Method: Morph>>updateFromResource (in category 'fileIn/out') -----
updateFromResource
	| pathName newMorph f |
	(pathName := self valueOfProperty: #resourceFilePath) ifNil: [^self].
	(pathName asLowercase endsWith: '.morph') 
		ifTrue: 
			[newMorph := (FileStream readOnlyFileNamed: pathName) fileInObjectAndCode.
			(newMorph isMorph) 
				ifFalse: [^self error: 'Resource not a single morph']]
		ifFalse: 
			[f := Form fromFileNamed: pathName.
			f ifNil: [^self error: 'unrecognized image file format'].
			newMorph := World drawingClass withForm: f].
	newMorph setProperty: #resourceFilePath toValue: pathName.
	self owner replaceSubmorph: self by: newMorph!

----- Method: Morph>>updateReferencesUsing: (in category 'copying') -----
updateReferencesUsing: aDictionary 
	"Update intra-morph references within a composite morph that 
	has been copied. For example, if a button refers to morph X in 
	the orginal 
	composite then the copy of that button in the new composite 
	should refer to 
	the copy of X in new composite, not the original X. This default 
	implementation updates the contents of any morph-bearing slot. 
	It may be 
	overridden to avoid this behavior if so desired."
	| old |
	Morph instSize + 1
		to: self class instSize
		do: [:i | 
			old := self instVarAt: i.
			old isMorph
				ifTrue: [self
						instVarAt: i
						put: (aDictionary
								at: old
								ifAbsent: [old])]].
	extension ifNotNil: [extension updateReferencesUsing: aDictionary]!

----- Method: Morph>>updateThumbnailUrl (in category 'thumbnail') -----
updateThumbnailUrl
	"If I have a cached thumbnail, then update it's urls."
	| cachedThumbnail |

	(cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
		[(cachedThumbnail respondsTo: #computeThumbnail) 
			ifTrue: [cachedThumbnail pageMorph: self url inBook: owner url]
			ifFalse: [self removeProperty: #computeThumbnail]].
			"Test and removal are because the thumbnail is being replaced 
			by another Morph.  We don't know why.  Need to fix that at 
			the source."!

----- Method: Morph>>updateThumbnailUrlInBook: (in category 'thumbnail') -----
updateThumbnailUrlInBook: bookUrl
	"If I have a cached thumbnail, then update it's urls."
	| cachedThumbnail |

	(cachedThumbnail := self valueOfProperty: #cachedThumbnail) ifNotNil:
		[(cachedThumbnail respondsTo: #computeThumbnail) 
			ifTrue: [cachedThumbnail pageMorph: self url inBook: bookUrl]
			ifFalse: [self removeProperty: #computeThumbnail]].
			"Test and removal are because the thumbnail is being replaced 
			by another Morph.  We don't know why.  Need to fix that at 
			the source."!

----- Method: Morph>>updateableActionMap (in category 'events-accessing') -----
updateableActionMap
	"Answer an updateable action map, saving it in my #actionMap property"
	
	| actionMap |
	actionMap := self valueOfProperty: #actionMap.
	actionMap ifNil:
		[actionMap := self createActionMap.
		self setProperty: #actionMap toValue: actionMap].
	^ actionMap!

----- Method: Morph>>url (in category 'accessing') -----
url
	"If I have been assigned a url, return it.  For PasteUpMorphs mostly."
	| sq |
	(sq := self sqkPage) ifNotNil: [^ sq url].
	^ self valueOfProperty: #url
		!

----- Method: Morph>>usableSiblingInstance (in category 'copying') -----
usableSiblingInstance
	"Return another similar morph whose Player is of the same class as mine.
	Do not open it in the world."

	| aName usedNames newPlayer newMorph topRenderer |
	(topRenderer := self topRendererOrSelf) == self 
		ifFalse: [^topRenderer usableSiblingInstance].
	self assuredPlayer assureUniClass.
	newMorph := self veryDeepCopySibling.
	newPlayer := newMorph player.
	newPlayer resetCostumeList.
	(aName := self knownName) isNil 
		ifTrue: [self player notNil ifTrue: [aName := newMorph innocuousName]].
	"Force a difference here"
	aName notNil 
		ifTrue: 
			[usedNames := (self world ifNil: [OrderedCollection new]
						ifNotNil: [self world allKnownNames]) copyWith: aName.
			newMorph setNameTo: (Utilities keyLike: aName
						satisfying: [:f | (usedNames includes: f) not])].
	newMorph privateOwner: nil.
	newPlayer assureEventHandlerRepresentsStatus.
	self presenter flushPlayerListCache.
	^newMorph!

----- Method: Morph>>useBitmapFill (in category 'visual properties') -----
useBitmapFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	| fill |
	self fillStyle isBitmapFill ifTrue:[^self]. "Already done"
	fill := BitmapFillStyle fromForm: self defaultBitmapFillForm.
	"Note: Must fix the origin due to global coordinates"
	fill origin: self bounds origin.
	self fillStyle: fill.!

----- Method: Morph>>useDefaultFill (in category 'visual properties') -----
useDefaultFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	self fillStyle: self defaultColor.!

----- Method: Morph>>useGradientFill (in category 'visual properties') -----
useGradientFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	| fill color1 color2 |
	self fillStyle isGradientFill ifTrue:[^self]. "Already done"
	color1 := self color asColor.
	color2 := color1 negated.
	fill := GradientFillStyle ramp: {0.0 -> color1. 1.0 -> color2}.
	fill origin: self topLeft.
	fill direction: 0 @ self bounds extent y.
	fill normal: self bounds extent x @ 0.
	fill radial: false.
	self fillStyle: fill!

----- Method: Morph>>useSolidFill (in category 'visual properties') -----
useSolidFill
	"Make receiver use a solid fill style (e.g., a simple color)"
	self fillStyle isSolidFill ifTrue:[^self]. "Already done"
	self fillStyle: self fillStyle asColor. "Try minimizing changes"!

----- Method: Morph>>userSelectedColor: (in category 'change reporting') -----
userSelectedColor: aColor
	"The user, via the UI, chose aColor to be the color for the receiver; set it, and tell my owner in case he wishes to react"
	self color: aColor.
	self world ifNotNil: [owner colorChangedForSubmorph: self]!

----- Method: Morph>>userString (in category 'accessing') -----
userString
	"Do I have a text string to be searched on?"

	^ nil!

----- Method: Morph>>vResizeToFit: (in category 'layout-properties') -----
vResizeToFit: aBoolean
	aBoolean ifTrue:[
		self vResizing: #shrinkWrap.
	] ifFalse:[
		self vResizing: #rigid.
	].!

----- Method: Morph>>vResizing (in category 'layout-properties') -----
vResizing
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#rigid] ifNotNil:[props vResizing].!

----- Method: Morph>>vResizing: (in category 'layout-properties') -----
vResizing: aSymbol
	"Layout specific. This property describes how the receiver should be resized with respect to its owner and its children. Possible values are:
		#rigid			-	do not resize the receiver
		#spaceFill		-	resize to fill owner's available space
		#shrinkWrap	- resize to fit children
	"
	self assureLayoutProperties vResizing: aSymbol.
	self layoutChanged.
!

----- Method: Morph>>vResizingString: (in category 'layout-properties') -----
vResizingString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self vResizing!

----- Method: Morph>>valueOfProperty: (in category 'accessing - properties') -----
valueOfProperty: aSymbol 
	"answer the value of the receiver's property named aSymbol"
	^ extension ifNotNil: [extension valueOfProperty: aSymbol]!

----- Method: Morph>>valueOfProperty:ifAbsent: (in category 'accessing - properties') -----
valueOfProperty: aSymbol ifAbsent: aBlock 
	"if the receiver possesses a property of the given name, answer  
	its value. If not then evaluate aBlock and answer the result of  
	this block evaluation"
	^ extension 
		ifNotNil: [extension valueOfProperty: aSymbol ifAbsent: aBlock]
		ifNil: [aBlock value]!

----- Method: Morph>>valueOfProperty:ifAbsentPut: (in category 'accessing - properties') -----
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	"If the receiver possesses a property of the given name, answer  
	its value. If not, then create a property of the given name, give 
	it the value obtained by evaluating aBlock, then answer that  
	value"
	^ self assureExtension valueOfProperty: aSymbol ifAbsentPut: aBlock!

----- Method: Morph>>valueOfProperty:ifPresentDo: (in category 'accessing - properties') -----
valueOfProperty: aSymbol ifPresentDo: aBlock 
	"If the receiver has a property of the given name, evaluate  
	aBlock on behalf of the value of that property"
	extension ifNil:  [^ self].
	^ aBlock value: (extension valueOfProperty: aSymbol ifAbsent: [^ self])!

----- Method: Morph>>vanishAfterSlidingTo:event: (in category 'dropping/grabbing') -----
vanishAfterSlidingTo: aPosition event: evt

	| aForm aWorld startPoint endPoint |
	aForm := self imageForm offset: 0 at 0.
	aWorld := self world.
	startPoint := evt hand fullBounds origin.
	self delete.
	aWorld displayWorld.
	endPoint := aPosition.
	aForm slideFrom: startPoint  to: endPoint nSteps: 12 delay: 15.
	Preferences soundsEnabled ifTrue: [TrashCanMorph playDeleteSound].
!

----- Method: Morph>>veryDeepCopyWith: (in category 'copying') -----
veryDeepCopyWith: deepCopier
	"Copy me and the entire tree of objects I point to.  An object in the tree twice is copied once, and both references point to him.  deepCopier holds a dictionary of objects we have seen.  See veryDeepInner:, veryDeepFixupWith:"

	self prepareToBeSaved.
	^ super veryDeepCopyWith: deepCopier!

----- Method: Morph>>veryDeepFixupWith: (in category 'copying') -----
veryDeepFixupWith: deepCopier
	"If some fields were weakly copied, fix new copy here."

	"super veryDeepFixupWith: deepCopier.	Object has no fixups, so don't call it"

	"If my owner is being duplicated too, then store his duplicate.
	 If I am owned outside the duplicated tree, then I am no longer owned!!"
	owner := deepCopier references at: owner ifAbsent: [nil].

!

----- Method: Morph>>veryDeepInner: (in category 'copying') -----
veryDeepInner: deepCopier 
	"The inner loop, so it can be overridden when a field should not  
	be traced."
	"super veryDeepInner: deepCopier.	know Object has no inst vars"
	bounds := bounds clone.
	"Points are shared with original"
	"owner := owner.	special, see veryDeepFixupWith:"
	submorphs := submorphs veryDeepCopyWith: deepCopier.
	"each submorph's fixup will install me as the owner"
	"fullBounds := fullBounds.	fullBounds is shared with original!!"
	color := color veryDeepCopyWith: deepCopier.
	"color, if simple, will return self. may be complex"
	extension := (extension veryDeepCopyWith: deepCopier)!

----- Method: Morph>>viewBox (in category 'accessing') -----
viewBox
	^ self pasteUpMorph viewBox!

----- Method: Morph>>viewMorphDirectly (in category 'debug and other') -----
viewMorphDirectly
	"Open a Viewer directly on the Receiver, i.e. no Player involved"

	self presenter viewObjectDirectly: self renderedMorph

	!

----- Method: Morph>>visible (in category 'drawing') -----
visible
	"answer whether the receiver is visible"
	extension ifNil: [^ true].
	^ extension visible!

----- Method: Morph>>visible: (in category 'drawing') -----
visible: aBoolean 
	"set the 'visible' attribute of the receiver to aBoolean"
	(extension isNil and:[aBoolean]) ifTrue: [^ self].
	self visible == aBoolean ifTrue: [^ self].
	self assureExtension visible: aBoolean.
	self changed!

----- Method: Morph>>visibleClearArea (in category 'accessing') -----
visibleClearArea
	"Answer the receiver visible clear area. The intersection 
	between the clear area and the viewbox."
	^ self viewBox intersect: self clearArea!

----- Method: Morph>>wantsBalloon (in category 'halos and balloon help') -----
wantsBalloon
	"Answer true if receiver wants to show a balloon help text is a few moments."

	^ (self balloonText notNil) and: [Preferences balloonHelpEnabled]!

----- Method: Morph>>wantsConnectorVocabulary (in category 'connectors-scripting') -----
wantsConnectorVocabulary
	"Answer true if I want to show a 'connector' vocabulary"
	^false!

----- Method: Morph>>wantsDirectionHandles (in category 'halos and balloon help') -----
wantsDirectionHandles
	^self valueOfProperty: #wantsDirectionHandles ifAbsent:[Preferences showDirectionHandles]!

----- Method: Morph>>wantsDirectionHandles: (in category 'halos and balloon help') -----
wantsDirectionHandles: aBool
	aBool == Preferences showDirectionHandles
		ifTrue:[self removeProperty: #wantsDirectionHandles]
		ifFalse:[self setProperty: #wantsDirectionHandles toValue: aBool].
!

----- Method: Morph>>wantsDropFiles: (in category 'event handling') -----
wantsDropFiles: anEvent
	"Return true if the receiver wants files dropped from the OS."
	^false!

----- Method: Morph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
wantsDroppedMorph: aMorph event: evt
	"Return true if the receiver wishes to accept the given morph, which is being dropped by a hand in response to the given event. Note that for a successful drop operation both parties need to agree. The symmetric check is done automatically via aMorph wantsToBeDroppedInto: self."

	^self dropEnabled!

----- Method: Morph>>wantsEmbeddingsVocabulary (in category 'accessing') -----
wantsEmbeddingsVocabulary
	"Empty method in absence of connectors"
	^ false!

----- Method: Morph>>wantsEveryMouseMove (in category 'event handling') -----
wantsEveryMouseMove
	"Unless overridden, this method allows processing to skip mouse move events
	when processing is lagging.  No 'significant' event (down/up, etc) will be skipped."

	^ false!

----- Method: Morph>>wantsHalo (in category 'halos and balloon help') -----
wantsHalo
	| topOwner |
	^(topOwner := self topRendererOrSelf owner) notNil 
		and: [topOwner wantsHaloFor: self]!

----- Method: Morph>>wantsHaloFor: (in category 'halos and balloon help') -----
wantsHaloFor: aSubMorph
	^ false!

----- Method: Morph>>wantsHaloFromClick (in category 'halos and balloon help') -----
wantsHaloFromClick
	^ true!

----- Method: Morph>>wantsHaloHandleWithSelector:inHalo: (in category 'halos and balloon help') -----
wantsHaloHandleWithSelector: aSelector inHalo: aHaloMorph
	"Answer whether the receiver would like to offer the halo handle with the given selector (e.g. #addCollapseHandle:)"

	(#(addDismissHandle:) includes: aSelector) ifTrue:
		[^ self resistsRemoval not].

	(#( addDragHandle: ) includes: aSelector) ifTrue:
		[^ self okayToBrownDragEasily].

	(#(addGrowHandle: addScaleHandle:) includes: aSelector) ifTrue:
		[^ self okayToResizeEasily].

	(#( addRotateHandle: ) includes: aSelector) ifTrue:
		[^ self okayToRotateEasily].

	(#(addRecolorHandle:) includes: aSelector) ifTrue:
		[^ self renderedMorph wantsRecolorHandle].

	true ifTrue: [^ true]
	!

----- Method: Morph>>wantsKeyboardFocusFor: (in category 'event handling') -----
wantsKeyboardFocusFor: aSubmorph
	"Answer whether a plain mouse click on aSubmorph, a text-edit-capable thing, should result in a text selection there"
	^ false!

----- Method: Morph>>wantsRecolorHandle (in category 'e-toy support') -----
wantsRecolorHandle
	"Answer whether the receiver would like a recoloring halo handle to be put up.  Since this handle also presently affords access to the property-sheet, it is presently always allowed, even though SketchMorphs don't like regular recoloring"

	^ true
	
!

----- Method: Morph>>wantsRoundedCorners (in category 'rounding') -----
wantsRoundedCorners
	"Return true if the receiver wants its corners rounded"
	^ self cornerStyle == #rounded!

----- Method: Morph>>wantsScriptorHaloHandle (in category 'halos and balloon help') -----
wantsScriptorHaloHandle
	"Answer whether the receiver would like to have a Scriptor halo handle put up on its behalf.  Initially, only the ScriptableButton says yes"

	^ false!

----- Method: Morph>>wantsSimpleSketchMorphHandles (in category 'halos and balloon help') -----
wantsSimpleSketchMorphHandles
	"Answer true if my halo's simple handles should include the simple sketch morph handles."
	^false!

----- Method: Morph>>wantsSteps (in category 'testing') -----
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 |
	self isPartsDonor ifTrue: [^ false].
	(self == self topRendererOrSelf) ifTrue: [self player wantsSteps ifTrue: [^ true]].
	c := self class.
	[c includesSelector: #step] whileFalse: [c := c superclass].
	^ c ~= Morph!

----- Method: Morph>>wantsToBeCachedByHand (in category 'accessing') -----
wantsToBeCachedByHand
	"Return true if the receiver wants to be cached by the hand when it is dragged around.
	Note: The default implementation queries all submorphs since subclasses may have shapes that do not fill the receiver's bounds completely."
	self hasTranslucentColor ifTrue:[^false].
	self submorphsDo:[:m|
		m wantsToBeCachedByHand ifFalse:[^false].
	].
	^true!

----- Method: Morph>>wantsToBeDroppedInto: (in category 'dropping/grabbing') -----
wantsToBeDroppedInto: aMorph
	"Return true if it's okay to drop the receiver into aMorph. This check is symmetric to #wantsDroppedMorph:event: to give both parties a chance of figuring out whether they like each other."
	^true!

----- Method: Morph>>wantsToBeOpenedInWorld (in category 'dropping/grabbing') -----
wantsToBeOpenedInWorld
	"Return true if the receiver wants to be put into the World directly,
	rather than allowing the user to place it (e.g., prevent attaching me
	to the hand after choosing 'new morph' in the world menu)"
	^false!

----- Method: Morph>>wantsToBeTopmost (in category 'accessing') -----
wantsToBeTopmost
	"Answer if the receiver want to be one of the topmost objects in its owner"
	^ self isFlapOrTab!

----- Method: Morph>>wantsWindowEvents: (in category 'event handling') -----
wantsWindowEvents: anEvent
	"Return true if the receiver wants to process host window events. These are only dispatched to the World anyway, but one could have an eventListener in the Hand or a windowEventHandler in the World"
	^false!

----- Method: Morph>>wantsYellowButtonMenu (in category 'menu') -----
wantsYellowButtonMenu
	"Answer true if the receiver wants a yellow button menu"
	self
		valueOfProperty: #wantsYellowButtonMenu
		ifPresentDo: [:value | ^ value].
	""
	self isInSystemWindow
		ifTrue: [^ false].""
	(Preferences noviceMode
			and: [self isInDockingBar])
		ifTrue: [^ false].""
	^ Preferences generalizedYellowButtonMenu!

----- Method: Morph>>wantsYellowButtonMenu: (in category 'menu') -----
wantsYellowButtonMenu: aBoolean 
	"Change the receiver to wants or not a yellow button menu"
	self setProperty: #wantsYellowButtonMenu toValue: aBoolean!

----- Method: Morph>>width (in category 'geometry') -----
width

	^ bounds width!

----- Method: Morph>>width: (in category 'geometry') -----
width: aNumber
	" Set my width; my position (top-left corner) and height will remain the same "

	self extent: aNumber asInteger at self height.
!

----- Method: Morph>>willingToBeDiscarded (in category 'dropping/grabbing') -----
willingToBeDiscarded
	^ true!

----- Method: Morph>>windowEvent: (in category 'event handling') -----
windowEvent: anEvent
	"Host window event"!

----- Method: Morph>>withAllOwners (in category 'structure') -----
withAllOwners
	"Return the receiver and all its owners"

	^ Array streamContents: [:strm | self withAllOwnersDo: [:m | strm nextPut: m]]!

----- Method: Morph>>withAllOwnersDo: (in category 'structure') -----
withAllOwnersDo: aBlock
	"Evaluate aBlock with the receiver and all of its owners"
	aBlock value: self.
	owner ifNotNil:[^owner withAllOwnersDo: aBlock].!

----- Method: Morph>>world (in category 'structure') -----
world
	^owner isNil ifTrue: [nil] ifFalse: [owner world]!

----- Method: Morph>>worldBounds (in category 'geometry') -----
worldBounds
	^ self world bounds!

----- Method: Morph>>worldBoundsForHalo (in category 'geometry') -----
worldBoundsForHalo
	"Answer the rectangle to be used as the inner dimension of my halos.
	Allow for showing either bounds or fullBounds, and compensate for the optional bounds rectangle."

	| r |
	r := (Preferences haloEnclosesFullBounds)
		ifFalse: [ self boundsIn: nil ]
		ifTrue: [ self fullBoundsInWorld ].
	Preferences showBoundsInHalo ifTrue: [ ^r outsetBy: 2 ].
	^r!

----- Method: Morph>>wouldAcceptKeyboardFocus (in category 'event handling') -----
wouldAcceptKeyboardFocus
	"Answer whether a plain mouse click on the receiver should result in a text selection there"
	^ false!

----- Method: Morph>>wouldAcceptKeyboardFocusUponTab (in category 'event handling') -----
wouldAcceptKeyboardFocusUponTab
	"Answer whether the receiver is in the running as the new keyboard focus if the tab key were hit at a meta level.  This provides the leverage for tabbing among fields of a card, for example."

	^ false!

----- Method: Morph>>wrap (in category 'geometry eToy') -----
wrap

	| myBox box newX newY wrapped |
	owner ifNil: [^ self].
	myBox := self fullBounds.
	myBox corner < (50000 at 50000) ifFalse: [
		self inform: 'Who is trying to wrap a hidden object?'. ^ self].
	box := owner bounds.
	newX := self position x.
	newY := self position y.
	wrapped := false.
	((myBox right < box left) or: [myBox left > box right]) ifTrue: [
		newX := box left + ((self position x - box left) \\ box width).
		wrapped := true].
	((myBox bottom < box top) or: [myBox top > box bottom]) ifTrue: [
		newY := box top + ((self position y - box top) \\ box height).
		wrapped := true].
	self position: newX at newY.
	(wrapped and: [owner isPlayfieldLike])
		ifTrue: [owner changed].  "redraw all turtle trails if wrapped"

!

----- Method: Morph>>wrapCentering (in category 'layout-properties') -----
wrapCentering
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of secondary direction
		#bottomRight - center at end of secondary direction
		#center - center in the middle of secondary direction
		#justified - insert extra space inbetween rows/columns
	"
	| props |
	props := self layoutProperties.
	^props ifNil:[#topLeft] ifNotNil:[props wrapCentering].!

----- Method: Morph>>wrapCentering: (in category 'layout-properties') -----
wrapCentering: aSymbol
	"Layout specific. This property describes how the rows/columns in a list-like layout should be centered.
		#topLeft - center at start of secondary direction
		#bottomRight - center at end of secondary direction
		#center - center in the middle of secondary direction
		#justified - insert extra space inbetween rows/columns
	"
	self assureTableProperties wrapCentering: aSymbol.
	self layoutChanged.!

----- Method: Morph>>wrapCenteringString: (in category 'layout-properties') -----
wrapCenteringString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self wrapCentering!

----- Method: Morph>>wrapDirection (in category 'layout-properties') -----
wrapDirection
	"Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
		#none
	indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
	| props |
	props := self layoutProperties.
	^props ifNil:[#none] ifNotNil:[props wrapDirection].!

----- Method: Morph>>wrapDirection: (in category 'layout-properties') -----
wrapDirection: aSymbol
	"Layout specific. This property describes the direction along which a list-like layout should be wrapped. Possible values are:
		#leftToRight
		#rightToLeft
		#topToBottom
		#bottomToTop
		#none
	indicating in which direction wrapping should occur. This direction must be orthogonal to the list direction, that is if listDirection is #leftToRight or #rightToLeft then wrapDirection must be #topToBottom or #bottomToTop and vice versa."
	self assureTableProperties wrapDirection: aSymbol.
	self layoutChanged.
!

----- Method: Morph>>wrapDirectionString: (in category 'layout-properties') -----
wrapDirectionString: aSymbol
	^self layoutMenuPropertyString: aSymbol from: self wrapDirection !

----- Method: Morph>>wrappedInWindow: (in category 'e-toy support') -----
wrappedInWindow: aSystemWindow
	| aWindow |
	aWindow := aSystemWindow model: Model new.
	aWindow addMorph: self frame: (0 at 0 extent: 1 at 1).
	aWindow extent: self extent.
	^ aWindow!

----- Method: Morph>>wrappedInWindowWithTitle: (in category 'e-toy support') -----
wrappedInWindowWithTitle: aTitle
	| aWindow w2 |
	aWindow := (SystemWindow labelled: aTitle) model: Model new.
	aWindow addMorph: self frame: (0 at 0 extent: 1 at 1).
	w2 := aWindow borderWidth * 2.
	w2 := 3.		"oh, well"
	aWindow extent: self fullBounds extent + (0 @ aWindow labelHeight) + (w2 @ w2).
	^ aWindow!

----- Method: Morph>>x (in category 'geometry eToy') -----
x
	"Return my horizontal position relative to the cartesian origin of a relevant playfield"

	| aPlayfield |
	aPlayfield := self referencePlayfield.
	^aPlayfield isNil 
		ifTrue: [self referencePosition x]
		ifFalse: [self referencePosition x - aPlayfield cartesianOrigin x]!

----- Method: Morph>>x: (in category 'geometry eToy') -----
x: aNumber 
	"Set my horizontal position relative to the cartesian origin of the playfield or the world."

	| offset aPlayfield newX |
	aPlayfield := self referencePlayfield.
	offset := self left - self referencePosition x.
	newX := aPlayfield isNil
				ifTrue: [aNumber + offset]
				ifFalse: [aPlayfield cartesianOrigin x + aNumber + offset].
	self position: newX @ bounds top!

----- Method: Morph>>x:y: (in category 'geometry eToy') -----
x: xCoord y: yCoord
	| aWorld xyOffset delta aPlayfield |
	(aWorld := self world) ifNil: [^ self position: xCoord @ yCoord].
	xyOffset := self topLeft - self referencePosition.
	delta := (aPlayfield := self referencePlayfield)
		ifNil:
			[xCoord @ (aWorld bottom - yCoord)]
		ifNotNil:
			[aPlayfield cartesianOrigin + (xCoord @ (yCoord negated))].
	self position: (xyOffset + delta)
!

----- Method: Morph>>y (in category 'geometry eToy') -----
y
	"Return my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen."

	| w aPlayfield |
	w := self world.
	w ifNil: [^bounds top].
	aPlayfield := self referencePlayfield.
	^aPlayfield isNil 
		ifTrue: [w cartesianOrigin y - self referencePosition y]
		ifFalse: [aPlayfield cartesianOrigin y - self referencePosition y]!

----- Method: Morph>>y: (in category 'geometry eToy') -----
y: aNumber 
	"Set my vertical position relative to the cartesian origin of the playfield or the world. Note that larger y values are closer to the top of the screen."

	| w offset newY aPlayfield |
	w := self world.
	w ifNil: [^self position: bounds left @ aNumber].
	aPlayfield := self referencePlayfield.
	offset := self top - self referencePosition y.
	newY := aPlayfield isNil
				ifTrue: [w bottom - aNumber + offset]
				ifFalse: [aPlayfield cartesianOrigin y - aNumber + offset].
	self position: bounds left @ newY!

----- Method: Morph>>yellowButtonActivity: (in category 'event handling') -----
yellowButtonActivity: shiftState 
	"Find me or my outermost owner that has items to add to a  
	yellow button menu.  
	shiftState is true if the shift was pressed.  
	Otherwise, build a menu that contains the contributions from  
	myself and my interested submorphs,  
	and present it to the user."
	| menu |
	self isWorldMorph
		ifFalse: [| outerOwner | 
			outerOwner := self outermostOwnerWithYellowButtonMenu.
			outerOwner
				ifNil: [^ self].
			outerOwner == self
				ifFalse: [^ outerOwner yellowButtonActivity: shiftState]].
	menu := self buildYellowButtonMenu: ActiveHand.
	menu
		addTitle: self externalName
		icon: (self iconOrThumbnailOfSize: (Preferences tinyDisplay ifTrue: [16] ifFalse: [28])).
	menu popUpInWorld: self currentWorld!

----- Method: Morph>>yellowButtonGestureDictionaryOrName: (in category 'geniestubs') -----
yellowButtonGestureDictionaryOrName: aSymbolOrDictionary!

Object subclass: #MorphExtension
	instanceVariableNames: 'locked visible sticky balloonText balloonTextSelector externalName isPartsDonor actorState player eventHandler otherProperties'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!MorphExtension commentStamp: '<historical>' prior: 0!
MorphExtension provides access to extra instance state that is not required in most simple morphs.  This allows simple morphs to remain relatively lightweight while still admitting more complex structures as necessary.  The otherProperties field takes this policy to the extreme of allowing any number of additional named attributes, albeit at a certain cost in speed and space.!

----- Method: MorphExtension>>actorState (in category 'accessing') -----
actorState
	"answer the redeiver's actorState"
	^ actorState !

----- Method: MorphExtension>>actorState: (in category 'accessing') -----
actorState: anActorState 
"change the receiver's actorState"
	actorState := anActorState!

----- Method: MorphExtension>>assureOtherProperties (in category 'accessing - other properties') -----
assureOtherProperties
	"creates an otherProperties for the receiver if needed"
	otherProperties ifNil: [self initializeOtherProperties].
	^ otherProperties!

----- Method: MorphExtension>>balloonText (in category 'accessing') -----
balloonText
	^ balloonText!

----- Method: MorphExtension>>balloonText: (in category 'accessing') -----
balloonText: newValue
	balloonText := newValue!

----- Method: MorphExtension>>balloonTextSelector (in category 'accessing') -----
balloonTextSelector
	^ balloonTextSelector!

----- Method: MorphExtension>>balloonTextSelector: (in category 'accessing') -----
balloonTextSelector: aSymbol 
	"change the receiver's balloonTextSelector"
	balloonTextSelector := aSymbol!

----- Method: MorphExtension>>comeFullyUpOnReload: (in category 'objects from disk') -----
comeFullyUpOnReload: smartRefStream
	"inst vars have default booplean values."

	locked ifNil: [locked := false].
	visible ifNil: [visible := true].
	sticky ifNil: [sticky := false].
	isPartsDonor ifNil: [isPartsDonor := false].
	^ self!

----- Method: MorphExtension>>copyWeakly (in category 'connectors-copying') -----
copyWeakly
	"list of names of properties whose values should be weak-copied when veryDeepCopying a morph.  See DeepCopier."

	^ #(formerOwner newPermanentPlayer logger graphModel gestureDictionaryOrName)
	"add yours to this list" 

	"formerOwner should really be nil at the time of the copy, but this will work just fine."!

----- Method: MorphExtension>>eventHandler (in category 'accessing') -----
eventHandler
	"answer the receiver's eventHandler"
	^ eventHandler !

----- Method: MorphExtension>>eventHandler: (in category 'accessing') -----
eventHandler: newValue
	eventHandler := newValue!

----- Method: MorphExtension>>externalName (in category 'viewer') -----
externalName
	^ externalName!

----- Method: MorphExtension>>externalName: (in category 'accessing') -----
externalName: aString 
	"change the receiver's externalName"
	externalName := aString!

----- Method: MorphExtension>>hasOtherProperties (in category 'accessing - other properties') -----
hasOtherProperties
	"answer whether the receiver has otherProperties"
	^ otherProperties notNil!

----- Method: MorphExtension>>hasProperty: (in category 'accessing - other properties') -----
hasProperty: aSymbol 
	"Answer whether the receiver has the property named aSymbol"
	| property |
	otherProperties ifNil: [^ false].
	property := otherProperties at: aSymbol ifAbsent: [].
	property isNil ifTrue: [^ false].
	property == false ifTrue: [^ false].
	^ true!

----- Method: MorphExtension>>initialize (in category 'initialization') -----
initialize
	"Init all booleans to default values"
	locked := false.
	visible := true.
	sticky := false.
	isPartsDonor := false.
!

----- Method: MorphExtension>>initializeOtherProperties (in category 'accessing - other properties') -----
initializeOtherProperties
	"private - initializes the receiver's otherProperties"
	otherProperties :=  IdentityDictionary new!

----- Method: MorphExtension>>inspectElement (in category 'other') -----
inspectElement
	"Create and schedule an Inspector on the otherProperties and the 
	named properties."
	| key obj |
	key := UIManager default chooseFrom: self sortedPropertyNames values: self sortedPropertyNames  title: 'Inspect which property?'.
	key
		ifNil: [^ self].
	obj := otherProperties
				at: key
				ifAbsent: ['nOT a vALuE'].
	obj = 'nOT a vALuE'
		ifTrue: [(self perform: key) inspect
			"named properties"]
		ifFalse: [obj inspect]!

----- Method: MorphExtension>>isDefault (in category 'other') -----
isDefault
	"Return true if the receiver is a default and can be omitted"
	locked == true
		ifTrue: [^ false].
	visible == false
		ifTrue: [^ false].
	sticky == true
		ifTrue: [^ false].
	balloonText isNil
		ifFalse: [^ false].
	balloonTextSelector isNil
		ifFalse: [^ false].
	externalName isNil
		ifFalse: [^ false].
	isPartsDonor == true
		ifTrue: [^ false].
	actorState isNil
		ifFalse: [^ false].
	player isNil
		ifFalse: [^ false].
	eventHandler isNil
		ifFalse: [^ false].
	otherProperties ifNotNil: [otherProperties isEmpty ifFalse: [^ false]].
	^ true!

----- Method: MorphExtension>>layoutFrame (in category 'accessing - layout properties') -----
layoutFrame
	^self valueOfProperty: #layoutFrame ifAbsent:[nil]!

----- Method: MorphExtension>>layoutFrame: (in category 'accessing - layout properties') -----
layoutFrame: aLayoutFrame 
	aLayoutFrame isNil
		ifTrue: [self removeProperty: #layoutFrame]
		ifFalse: [self setProperty: #layoutFrame toValue: aLayoutFrame]!

----- Method: MorphExtension>>layoutPolicy (in category 'accessing - layout properties') -----
layoutPolicy
	^self valueOfProperty: #layoutPolicy ifAbsent:[nil]!

----- Method: MorphExtension>>layoutPolicy: (in category 'accessing - layout properties') -----
layoutPolicy: aLayoutPolicy 
	aLayoutPolicy isNil
		ifTrue: [self removeProperty: #layoutPolicy]
		ifFalse: [self setProperty: #layoutPolicy toValue: aLayoutPolicy]!

----- Method: MorphExtension>>layoutProperties (in category 'accessing - layout properties') -----
layoutProperties
	^self valueOfProperty: #layoutProperties ifAbsent:[nil]!

----- Method: MorphExtension>>layoutProperties: (in category 'accessing - layout properties') -----
layoutProperties: newProperties 
	"Return the current layout properties associated with the receiver"

	newProperties isNil
		ifTrue: [self removeProperty: #layoutProperties]
		ifFalse: [self setProperty: #layoutProperties toValue: newProperties]!

----- Method: MorphExtension>>locked (in category 'accessing') -----
locked
	"answer whether the receiver is Locked"
	^ locked!

----- Method: MorphExtension>>locked: (in category 'accessing') -----
locked: aBoolean 
	"change the receiver's locked property"
	locked := aBoolean!

----- Method: MorphExtension>>otherProperties (in category 'accessing - other properties') -----
otherProperties
	"answer the receiver's otherProperties"
	^ otherProperties!

----- Method: MorphExtension>>player (in category 'accessing') -----
player
	"answer the receiver's player"
	^ player!

----- Method: MorphExtension>>player: (in category 'accessing') -----
player: anObject 
	"change the receiver's player"
	player := anObject !

----- Method: MorphExtension>>printOn: (in category 'printing') -----
printOn: aStream 
	"Append to the argument, aStream, a sequence of characters that 
	identifies the receiver." 
	super printOn: aStream.
	aStream nextPutAll: ' ' , self identityHashPrintString.
	locked == true
		ifTrue: [aStream nextPutAll: ' [locked] '].
	visible == false
		ifTrue: [aStream nextPutAll: '[not visible] '].
	sticky == true
		ifTrue: [aStream nextPutAll: ' [sticky] '].
	balloonText
		ifNotNil: [aStream nextPutAll: ' [balloonText] '].
	balloonTextSelector
		ifNotNil: [aStream nextPutAll: ' [balloonTextSelector: ' , balloonTextSelector printString , '] '].
	externalName
		ifNotNil: [aStream nextPutAll: ' [externalName = ' , externalName , ' ] '].
	isPartsDonor == true
		ifTrue: [aStream nextPutAll: ' [isPartsDonor] '].
	player
		ifNotNil: [aStream nextPutAll: ' [player = ' , player printString , '] '].
	eventHandler
		ifNotNil: [aStream nextPutAll: ' [eventHandler = ' , eventHandler printString , '] '].
	(otherProperties isNil or: [otherProperties isEmpty ]) ifTrue: [^ self].
	aStream nextPutAll: ' [other: '.
	self otherProperties
		keysDo: [:aKey | aStream nextPutAll: ' (' , aKey , ' -> ' , (self otherProperties at: aKey) printString , ')'].
	aStream nextPut: $]!

----- Method: MorphExtension>>privateOtherProperties: (in category 'accessing - other properties') -----
privateOtherProperties: anIdentityDictionary 
	"private - change the receiver's otherProperties"
	otherProperties := anIdentityDictionary !

----- Method: MorphExtension>>propertyNamesNotCopied (in category 'connectors-copying') -----
propertyNamesNotCopied
	"list of names of properties whose values should be deleted when veryDeepCopying a morph.
	See DeepCopier."

	^ #(connectedConstraints connectionHighlights highlightedTargets)
	"add yours to this list" 
!

----- Method: MorphExtension>>removeOtherProperties (in category 'accessing - other properties') -----
removeOtherProperties
	"Remove the 'other' properties"
	otherProperties := nil!

----- Method: MorphExtension>>removeProperty: (in category 'accessing - other properties') -----
removeProperty: aSymbol 
	"removes the property named aSymbol if it exists"
	otherProperties ifNil: [^ self].
	otherProperties removeKey: aSymbol ifAbsent: [].
	otherProperties isEmpty ifTrue: [self removeOtherProperties]!

----- Method: MorphExtension>>setProperty:toValue: (in category 'accessing - other properties') -----
setProperty: aSymbol toValue: abObject 
	"change the receiver's property named aSymbol to anObject"
	self assureOtherProperties at: aSymbol put: abObject!

----- Method: MorphExtension>>sortedPropertyNames (in category 'accessing - other properties') -----
sortedPropertyNames
	"answer the receiver's property names in a sorted way"

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

----- Method: MorphExtension>>sticky (in category 'accessing') -----
sticky
	^ sticky!

----- Method: MorphExtension>>sticky: (in category 'accessing') -----
sticky: aBoolean 
	"change the receiver's sticky property"
	sticky := aBoolean!

----- Method: MorphExtension>>valueOfProperty: (in category 'accessing - other properties') -----
valueOfProperty: aSymbol 
"answer the value of the receiver's property named aSymbol"
	^ self
		valueOfProperty: aSymbol
		ifAbsent: []!

----- Method: MorphExtension>>valueOfProperty:ifAbsent: (in category 'accessing - other properties') -----
valueOfProperty: aSymbol ifAbsent: aBlock 
	"if the receiver possesses a property of the given name, answer  
	its value. If not then evaluate aBlock and answer the result of  
	this block evaluation"
	otherProperties ifNil: [^ aBlock value].
	^ otherProperties at: aSymbol ifAbsent: [^ aBlock value]!

----- Method: MorphExtension>>valueOfProperty:ifAbsentPut: (in category 'accessing - other properties') -----
valueOfProperty: aSymbol ifAbsentPut: aBlock 
	"If the receiver possesses a property of the given name, answer  
	its value. If not, then create a property of the given name, give 
	it the value obtained by evaluating aBlock, then answer that  
	value"
	^self assureOtherProperties at: aSymbol ifAbsentPut: aBlock!

----- Method: MorphExtension>>veryDeepFixupWith: (in category 'connectors-copying') -----
veryDeepFixupWith: deepCopier 
	"If target and arguments fields were weakly copied, fix them here.
	If they were in the tree being copied, fix them up, otherwise point to the originals!!!!"

	super veryDeepFixupWith: deepCopier.
	otherProperties ifNil: [ ^self ].

	"Properties whose values are only copied weakly replace those values if they were copied via another path"
	self copyWeakly do: [ :propertyName |
		otherProperties at: propertyName ifPresent: [ :property |
			otherProperties at: propertyName
				put: (deepCopier references at: property ifAbsent: [ property ])]].
!

----- Method: MorphExtension>>veryDeepInner: (in category 'connectors-copying') -----
veryDeepInner: deepCopier 
	"Copy all of my instance variables.
	Some otherProperties need to be not copied at all, but shared. Their names are given by copyWeakly.
	Some otherProperties should not be copied or shared. Their names are given by propertyNamesNotCopied.
	This is special code for the dictionary. See DeepCopier, and veryDeepFixupWith:."

	| namesOfWeaklyCopiedProperties weaklyCopiedValues |
	super veryDeepInner: deepCopier.
	locked := locked veryDeepCopyWith: deepCopier.
	visible := visible veryDeepCopyWith: deepCopier.
	sticky := sticky veryDeepCopyWith: deepCopier.
	balloonText := balloonText veryDeepCopyWith: deepCopier.
	balloonTextSelector := balloonTextSelector veryDeepCopyWith: deepCopier.
	externalName := externalName veryDeepCopyWith: deepCopier.
	isPartsDonor := isPartsDonor veryDeepCopyWith: deepCopier.
	actorState := actorState veryDeepCopyWith: deepCopier.
	player := player veryDeepCopyWith: deepCopier.		"Do copy the player of this morph"
	eventHandler := eventHandler veryDeepCopyWith: deepCopier. 	"has its own restrictions"

	otherProperties ifNil: [ ^self ].

	otherProperties := otherProperties copy.
	self propertyNamesNotCopied do: [ :propName | otherProperties removeKey: propName ifAbsent: [] ].

	namesOfWeaklyCopiedProperties := self copyWeakly.
	weaklyCopiedValues := namesOfWeaklyCopiedProperties collect: [  :propName | otherProperties removeKey: propName ifAbsent: [] ].

	"Now copy all the others."
	otherProperties := otherProperties veryDeepCopyWith: deepCopier.

	"And replace the weak ones."
	namesOfWeaklyCopiedProperties with: weaklyCopiedValues do: [ :name :value | value ifNotNil: [ otherProperties at: name put: value ]].
!

----- Method: MorphExtension>>visible (in category 'accessing') -----
visible
	"answer whether the receiver is visible"
	^ visible!

----- Method: MorphExtension>>visible: (in category 'accessing') -----
visible: newValue
	visible := newValue!

Object subclass: #MouseClickState
	instanceVariableNames: 'clickClient clickState firstClickDown firstClickUp firstClickTime clickSelector dblClickSelector dblClickTime dblClickTimeoutSelector dragSelector dragThreshold'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!MouseClickState commentStamp: '<historical>' prior: 0!
MouseClickState is a simple class managing the distinction between clicks, double clicks, and drag operations. It has been factored out of HandMorph due to the many instVars.

Instance variables:
	clickClient 	<Morph>		The client wishing to receive #click:, #dblClick:, or #drag messages
	clickState 	<Symbol>	The internal state of handling the last event (#firstClickDown, #firstClickUp, #firstClickTimedOut)
	firstClickDown 	<MorphicEvent>	The #mouseDown event after which the client wished to receive #click: or similar messages
	firstClickUp 	<MorphicEvent>	The first mouse up event which came in before the double click time out was exceeded (it is sent if there is a timout after the first mouse up event occured)
	firstClickTime 	<Integer>	The millisecond clock value of the first event
	clickSelector 	<Symbol>	The selector to use for sending #click: messages
	dblClickSelector 	<Symbol>	The selector to use for sending #doubleClick: messages
	dblClickTime 	<Integer>	Timout in milliseconds for a double click operation
	dragSelector 	<Symbol>	The selector to use for sending #drag: messages
	dragThreshold 	<Integer>	Threshold used for determining if a #drag: message is sent (pixels!!)
!

----- Method: MouseClickState>>click (in category 'event handling') -----
click

	clickSelector ifNotNil: [clickClient perform: clickSelector with: firstClickDown]!

----- Method: MouseClickState>>client:click:dblClick:dblClickTime:dblClickTimeout:drag:threshold:event: (in category 'initialize') -----
client: aMorph click: aClickSelector dblClick: aDblClickSelector dblClickTime: timeOut dblClickTimeout: aDblClickTimeoutSelector drag: aDragSelector threshold: aNumber event: firstClickEvent
	clickClient := aMorph.
	clickSelector := aClickSelector.
	dblClickSelector := aDblClickSelector.
	dblClickTime := timeOut.
	dblClickTimeoutSelector := aDblClickTimeoutSelector.
	dragSelector := aDragSelector.
	dragThreshold := aNumber.
	firstClickDown := firstClickEvent.
	firstClickTime := firstClickEvent timeStamp.
	clickState := #firstClickDown.!

----- Method: MouseClickState>>doubleClick (in category 'event handling') -----
doubleClick

	dblClickSelector ifNotNil: [clickClient perform: dblClickSelector with: firstClickDown]!

----- Method: MouseClickState>>doubleClickTimeout (in category 'event handling') -----
doubleClickTimeout

	dblClickTimeoutSelector ifNotNil: [
		clickClient perform: dblClickTimeoutSelector with: firstClickDown]!

----- Method: MouseClickState>>drag: (in category 'event handling') -----
drag: event

	dragSelector ifNotNil: [clickClient perform: dragSelector with: event]!

----- Method: MouseClickState>>handleEvent:from: (in category 'event handling') -----
handleEvent: evt from: aHand
	"Process the given mouse event to detect a click, double-click, or drag.
	Return true if the event should be processed by the sender, false if it shouldn't.
	NOTE: This method heavily relies on getting *all* mouse button events."
	| localEvt timedOut isDrag |
	timedOut := (evt timeStamp - firstClickTime) > dblClickTime.
	localEvt := evt transformedBy: (clickClient transformedFrom: aHand owner).
	isDrag := (localEvt position - firstClickDown position) r > dragThreshold.
	clickState == #firstClickDown ifTrue: [
		"Careful here - if we had a slow cycle we may have a timedOut mouseUp event"
		(timedOut and:[localEvt isMouseUp not]) ifTrue:[
			"timeout before #mouseUp -> keep waiting for drag if requested"
			clickState := #firstClickTimedOut.
			dragSelector ifNil:[
				aHand resetClickState.
				self doubleClickTimeout; click "***"].
			^true].
		localEvt isMouseUp ifTrue:[

			(timedOut or:[dblClickSelector isNil]) ifTrue:[
				self click.
				aHand resetClickState.
				^true].
			"Otherwise transfer to #firstClickUp"
			firstClickUp := evt copy.
			clickState := #firstClickUp.
			"If timedOut or the client's not interested in dbl clicks get outta here"
			self click.
			aHand handleEvent: firstClickUp.
			^false].
		isDrag ifTrue:["drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [self click]
				ifNotNil: [self drag: firstClickDown].
			^true].
		^false].

	clickState == #firstClickTimedOut ifTrue:[
		localEvt isMouseUp ifTrue:["neither drag nor double click"
			aHand resetClickState.
			self doubleClickTimeout; click. "***"
			^true].
		isDrag ifTrue:["drag start"
			aHand resetClickState.
			self doubleClickTimeout; drag: firstClickDown. "***"
			^true].
		^false].

	clickState = #firstClickUp ifTrue:[
		(timedOut) ifTrue:[
			"timed out after mouseUp - signal timeout and pass the event"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true].
		localEvt isMouseDown ifTrue:["double click"
			clickState := #secondClickDown.
			^false]].

	clickState == #secondClickDown ifTrue: [
		timedOut ifTrue:[
			"timed out after second mouseDown - pass event after signaling timeout"
			aHand resetClickState.
			self doubleClickTimeout. "***"
			^true].
		isDrag ifTrue: ["drag start"
			self doubleClickTimeout. "***"
			aHand resetClickState.
			dragSelector "If no drag selector send #click instead"
				ifNil: [self click]
				ifNotNil: [self drag: firstClickDown].
			^true].
		localEvt isMouseUp ifTrue: ["double click"
			aHand resetClickState.
			self doubleClick.
			^false]
	].

	^true
!

----- Method: MouseClickState>>printOn: (in category 'as yet unclassified') -----
printOn: aStream
	super printOn: aStream.
	aStream nextPut: $[; print: clickState; nextPut: $]
!

Object subclass: #TheWorldMainDockingBar
	instanceVariableNames: ''
	classVariableNames: 'Instance TS'
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

----- Method: TheWorldMainDockingBar class>>initialize (in category 'class initialization') -----
initialize
	" self initialize "
	
	Locale addLocalChangedListener: self.
	self updateInstances.!

----- Method: TheWorldMainDockingBar class>>instance (in category 'instance creation') -----
instance
	"Answer the receiver's instance"
	^ Instance
		ifNil: [Instance := super new]!

----- Method: TheWorldMainDockingBar class>>localeChanged (in category 'as yet unclassified') -----
localeChanged
	self updateInstances!

----- Method: TheWorldMainDockingBar class>>new (in category 'instance creation') -----
new
	"Singleton, use #instance"
	^ self error: 'Use #instance'!

----- Method: TheWorldMainDockingBar class>>setTimeStamp (in category 'timestamping') -----
setTimeStamp
	"Change the receiver's timeStamp"
	TS := UUID new!

----- Method: TheWorldMainDockingBar class>>showWorldMainDockingBar (in category 'preferences') -----
showWorldMainDockingBar
	
	<preference: 'Show world main docking bar'
		category: 'docking bars'
		description: 'Whether world''s main docking bar should be shown or not.'
		type: #Boolean>
	^Project current showWorldMainDockingBar!

----- Method: TheWorldMainDockingBar class>>showWorldMainDockingBar: (in category 'preferences') -----
showWorldMainDockingBar: aBoolean
	
	Project current showWorldMainDockingBar: aBoolean!

----- Method: TheWorldMainDockingBar class>>timeStamp (in category 'timestamping') -----
timeStamp
	"Answer the receiver's timeStamp"
	^ TS!

----- Method: TheWorldMainDockingBar class>>updateInstances (in category 'events') -----
updateInstances
	"The class has changed, time to update the instances"

	self setTimeStamp.
	Project current assureMainDockingBarPresenceMatchesPreference!

----- Method: TheWorldMainDockingBar class>>updateInstances: (in category 'events') -----
updateInstances: anEvent 
	"The class has changed, time to update the instances"
	(anEvent itemClass == self
			or: [anEvent itemClass == self class])
		ifFalse: [^ self].
	""
	self updateInstances!

----- Method: TheWorldMainDockingBar>>aboutMenuItemOn: (in category 'submenu - squeak') -----
aboutMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'About Squeak...' translated;
			target: self;
			selector: #aboutSqueak ]!

----- Method: TheWorldMainDockingBar>>aboutSqueak (in category 'menu actions') -----
aboutSqueak
	UserDialogBoxMorph
		inform: SmalltalkImage current systemInformationString withCRs
		title: 'About Squeak:'
		at: World center.
!

----- Method: TheWorldMainDockingBar>>allOtherWindowsLike: (in category 'submenu - windows') -----
allOtherWindowsLike: window
	^ self allVisibleWindows reject: [:each |
		each model name ~= window model name or: [each = window]]!

----- Method: TheWorldMainDockingBar>>allVisibleWindows (in category 'submenu - windows') -----
allVisibleWindows
	^SystemWindow windowsIn: World satisfying: [ :w | w visible ]!

----- Method: TheWorldMainDockingBar>>allWindowsLike: (in category 'submenu - windows') -----
allWindowsLike: window
	^ self allVisibleWindows reject: [:each | each model ~= window model or: [each = window]]!

----- Method: TheWorldMainDockingBar>>appsMenuOn: (in category 'submenu - apps') -----
appsMenuOn: aDockingBar
	"Create a menu with the registered apps"

	aDockingBar addItem: [ :item |
		item
			contents: 'Apps' translated;
			subMenuUpdater: self
			selector: #listAppsOn: ]
!

----- Method: TheWorldMainDockingBar>>browserMenuItemOn: (in category 'submenu - tools') -----
browserMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Browser' translated;
			help: 'Open a browser' translated;
			icon: (self colorIcon: Preferences browserWindowColor);
			target: StandardToolSet;
			selector: #openClassBrowser ]!

----- Method: TheWorldMainDockingBar>>clockOn: (in category 'right side') -----
clockOn: aDockingBar 

	aDockingBar 
		addMorphBack: (
			ClockMorph new
				showSeconds: false;
				yourself);
		addDefaultSpace!

----- Method: TheWorldMainDockingBar>>closeAllWindowsBut: (in category 'submenu - windows') -----
closeAllWindowsBut: window
	(self allOtherWindowsLike: window) do: [:each |
		each model canDiscardEdits ifTrue: [each delete]]!

----- Method: TheWorldMainDockingBar>>closeAllWindowsLike: (in category 'submenu - windows') -----
closeAllWindowsLike: window
	self closeAllWindowsBut: window.
	window model canDiscardEdits ifTrue: [window delete]!

----- Method: TheWorldMainDockingBar>>colorIcon: (in category 'private') -----
colorIcon: aColor

	"Guess if 'uniform window colors' are used and avoid all icons to be just gray"
	(aColor = Preferences uniformWindowColor or: [Preferences tinyDisplay]) ifTrue: [ ^nil ].
	^(aColor iconOrThumbnailOfSize: 14)
		borderWidth: 3 color: Preferences menuColor muchDarker;
		borderWidth: 2 color: Color transparent!

----- Method: TheWorldMainDockingBar>>createDockingBar (in category 'construction') -----
createDockingBar
	"Create a docking bar from the receiver's representation"
	
	| dockingBar |
	dockingBar := DockingBarMorph new
		adhereToTop;
		color: Preferences menuColor;
		gradientRamp: self gradientRamp;
		autoGradient: ColorTheme current dockingBarAutoGradient;
		borderWidth: 0.
	self fillDockingBar: dockingBar.
	^ dockingBar!

----- Method: TheWorldMainDockingBar>>dualChangeSorterMenuItemOn: (in category 'submenu - tools') -----
dualChangeSorterMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Dual Change Sorter' translated;
			help: 'Open a Dual Change Sorter' translated;
			icon: (self colorIcon: ChangeSorter basicNew defaultBackgroundColor);
			target: DualChangeSorter;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>extendingTheSystem (in category 'submenu - help') -----
extendingTheSystem
	^'"Note: Please edit this workspace and add your own contributions.
To submit it to the inbox open the Monticello browser and submit it from there.
Save the package ''* Morphic'' to the inbox."

"Updating your system:
The following will set the default update URL to receive development updates. 
For developers and dare-devils only."

MCMcmUpdater defaultUpdateURL: ''http://source.squeak.org/trunk''.

"Installing new packages: 
The following expression show how to load many interesting packages into Squeak."

"FFI: http://source.squeak.org/FFI.html"
(Installer repository: ''http://source.squeak.org/FFI'')
	install: ''FFI-Pools'';
	install: ''FFI-Kernel'';
	install: ''FFI-Tests'';
	install: ''FFI-Win32'';
	install: ''FFI-MacOS'';
	install: ''FFI-Unix''.

"Omnibrowser"
(Installer wiresong project: ''ob'')
	    install: ''OmniBrowser'';
	    install: ''OB-Morphic'';
	    install: ''OB-Standard'';
	    install: ''OB-Shout'';
	    install: ''OB-SUnitIntegration''. 

"Refactoring engine and OB integration"
(Installer ss project: ''rb'')
	install: ''AST-Core-lr.80.mcz'';
	install: ''AST-Semantic-lr.11.mcz'';
	install: ''Refactoring-Core-lr.149.mcz'';
	install: ''Refactoring-Spelling'';
	project: ''Regex'';
	install: ''VB-Regex''.
(Installer wiresong project: ''ob'')
	install: ''OB-Refactory'';
	install: ''OB-Regex''.

"Seaside 2.8 http://www.seaside.st"
(Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfSeaside28''.
"WAKom startOn: 9090"

"Seaside 2.8 Examples http://www.seaside.st"
(Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfSeaside28Examples''.
(Smalltalk at: #ConfigurationOfSeaside28Examples) load.

"Seaside 3.0 http://www.seaside.st"
(Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfSeaside30''.
(Smalltalk at: #ConfigurationOfSeaside30) load.
(Smalltalk at: #WASqueakServerAdaptorBrowser) open.

"Pier CMS: http://www.piercms.com"
(Installer ss project: ''MetacelloRepository'') install: ''ConfigurationOfPier2''.
(Smalltalk at: #ConfigurationOfPier2) load.

(Installer lukas project: ''pier2'') install: ''Pier-Blog''.
(Installer lukas project: ''pier2'') install: ''Pier-Book''.
(Installer lukas project: ''pier2addons'') install: ''Pier-Setup''.
(Smalltalk at: #PRDistribution)  new register.
!!
]style[(189 2 139 15 17 1 32 3 108 2 40 12 11 1 30 3 8 1 11 3 8 1 12 3 8 1 11 3 8 1 11 3 8 1 11 3 8 1 10 3 13 12 8 1 8 1 4 7 8 1 13 7 8 1 12 7 8 1 13 7 8 1 10 7 8 1 21 4 39 12 2 1 8 1 4 3 8 1 5 3 8 1 18 3 8 1 22 3 8 1 7 3 8 1 10 13 8 1 8 1 4 3 8 1 14 3 8 1 10 3 35 12 2 1 8 1 21 2 8 1 26 2 21 2 44 12 2 1 8 1 21 2 8 1 34 13 3 1 33 2 4 3 35 12 2 1 8 1 21 2 8 1 26 13 3 1 25 2 4 13 3 1 29 2 4 3 34 12 2 1 8 1 21 2 8 1 22 13 3 1 21 2 4 14 5 1 8 1 7 2 8 1 11 13 5 1 8 1 7 2 8 1 11 13 5 1 8 1 13 2 8 1 12 13 3 1 15 3 3 1 8 2)c000126126,cblack;,c000126126,cblack;,c000000126,cblack;,c126000126,cblack;,c000126126,cblack;,c000126126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000126126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000126126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c126000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>extrasMenuOn: (in category 'construction') -----
extrasMenuOn: aDockingBar 

	aDockingBar addItem: [ :it|
		it 	contents: 'Extras' translated;
			addSubMenu: [:menu|
				menu addItem:[:item|
					item
						contents: 'Recover Changes' translated;
						help: 'Recover changes after a crash' translated;
						icon: MenuIcons smallHelpIcon;
						target: ChangeList;
						selector: #browseRecentLog].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Window Colors' translated;
						help: 'Changes the window color scheme' translated;
						addSubMenu:[:submenu| self windowColorsOn: submenu]].
				menu addItem:[:item|
					item
						contents: 'Set Author Initials' translated;
						help: 'Sets the author initials' translated;
						target: Utilities;
						selector: #setAuthorInitials].
				menu addItem:[:item|
					item
						contents: 'Restore Display (r)' translated;
						help: 'Redraws the entire display' translated;
						target: World;
						selector: #restoreMorphicDisplay].
				menu addItem:[:item|
					item
						contents: 'Rebuild Menus' translated;
						help: 'Rebuilds the menu bar' translated;
						target: TheWorldMainDockingBar;
						selector: #updateInstances].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Start Profiler' translated;
						help: 'Starts the profiler' translated;
						target: self;
						selector: #startMessageTally].
				menu addItem:[:item|
					item
						contents: 'Collect Garbage' translated;
						help: 'Run the garbage collector and report space usage' translated;
						target: Utilities;
						selector: #garbageCollectAndReport].
				menu addItem:[:item|
					item
						contents: 'Purge Undo Records' translated;
						help: 'Save space by removing all the undo information remembered in all projects' translated;
						target: CommandHistory;
						selector: #resetAllHistory].
				menu addItem:[:item|
					item
						contents: 'VM statistics' translated;
						help: 'Virtual Machine information' translated;
						target: self;
						selector: #vmStatistics].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Graphical Imports' translated;
						help: 'View the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList' translated;
						target: (Imports default);
						selector: #viewImages].
				menu addItem:[:item|
					item
						contents: 'Standard Graphics Library' translated;
						help: 'Lets you view and change the system''s standard library of graphics' translated;
						target: ScriptingSystem;
						selector: #inspectFormDictionary].
				menu addItem:[:item|
					item
						contents: 'Annotation Setup' translated;
						help: 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools' translated;
						target: Preferences;
						selector: #editAnnotations].
			] ]!

----- Method: TheWorldMainDockingBar>>fileListMenuItemOn: (in category 'submenu - tools') -----
fileListMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'File List' translated;
			help: 'Open a file list' translated;
			icon: (self colorIcon: Preferences fileListWindowColor);
			target: StandardToolSet;
			selector: #openFileList ]!

----- Method: TheWorldMainDockingBar>>fillDockingBar: (in category 'construction') -----
fillDockingBar: aDockingBar 
	"Private - fill the given docking bar"
	
	aDockingBar addSpace: 6.
	self menusOn: aDockingBar.
	aDockingBar
		setProperty: #mainDockingBarTimeStamp 
		toValue: self class timeStamp!

----- Method: TheWorldMainDockingBar>>gradientRamp (in category 'private') -----
gradientRamp

	^{ 
		0.0 -> Color white.
		1.0 -> Preferences menuColor darker }!

----- Method: TheWorldMainDockingBar>>helpMenuOn: (in category 'submenu - help') -----
helpMenuOn: aDockingBar

	aDockingBar addItem: [ :it |
		it	contents: 'Help' translated;
			addSubMenu: [ :menu |  'Todo'.
				menu addItem:[:item|
					item
						contents: 'Online Resources' translated;
						help: 'Online resources for Squeak' translated;
						target: self;
						icon: MenuIcons smallHelpIcon;
						selector: #showWelcomeText:label:in:;
						arguments: {
							#squeakOnlineResources. 
							'Squeak Online Resources'. 
							(140 at 140 extent: 560 at 360)
						}].
				menu addItem:[:item|
					item
						contents: 'Keyboard Shortcuts' translated;
						help: 'Keyboard bindings used in Squeak' translated;
						target: Utilities;
						selector: #openCommandKeyHelp ].
				menu addItem:[:item|
					item
						contents: 'Font Size Summary' translated;
						help: 'Font size summary from the old Squeak 3.10.2 help menu.' translated;
						target: TextStyle;
						selector: #fontSizeSummary ].
				menu addItem:[:item|
					item
						contents: 'Useful Expressions' translated;
						help: 'Useful expressions from the old Squeak 3.10.2 help menu.' translated;
						target: Utilities;
						selector: #openStandardWorkspace ].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Extending the system' translated;
						help: 'Includes code snippets to evaluate for extending the system' translated;
						target: self;
						icon: MenuIcons smallHelpIcon;
						selector: #showWelcomeText:label:in:;
						arguments: {
							#extendingTheSystem. 
							'How to extend the system'. 
							(140 at 140 extent: 560 at 360)
						}].
				menu addLine.
				menu addItem:[:item|
					item
						contents: 'Welcome Workspaces' translated;
						help: 'The Welcome Workspaces' translated;
						addSubMenu:[:submenu| self welcomeWorkspacesOn: submenu]].
				(Smalltalk classNamed: #HelpBrowser) ifNotNil: 
					[:classHelpBrowser|
					menu addLine.
					menu addItem: [ :item |
						item
							contents: 'Help Browser' translated;
							help: 'Integrated Help System' translated;
							target: classHelpBrowser;
							selector: #open ] ].
			]].!

----- Method: TheWorldMainDockingBar>>jumpToProjectMenuItemOn: (in category 'submenu - projects') -----
jumpToProjectMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Jump To Project' translated;
			icon: MenuIcons smallForwardIcon;
			subMenuUpdater: self
			selector: #updateJumpToProjectSubMenu: ]!

----- Method: TheWorldMainDockingBar>>licenseInformation (in category 'submenu - help') -----
licenseInformation
	"Should NOT be edited interactively"
	^Smalltalk license asText!

----- Method: TheWorldMainDockingBar>>listAppsOn: (in category 'submenu - apps') -----
listAppsOn: menu
	"Update the apps list in the menu"

	| args |
	TheWorldMenu registeredOpenCommands do:[:spec|
		args := spec second.
		menu addItem: [ :item |
			item
				contents: spec first translated;
				target: args first;
				selector: args second].
	].
!

----- Method: TheWorldMainDockingBar>>listWindowsOn: (in category 'submenu - windows') -----
listWindowsOn: menu

	| windows |
	windows := SortedCollection sortBlock: [:winA :winB |
		winA model name = winB model name
			ifTrue: [winA label < winB label]
			ifFalse: [winA model name < winB model name]].
	windows addAll: self allVisibleWindows.
	windows ifEmpty: [ 
		menu addItem: [ :item | 
			item
				contents: 'No Windows' translated;
				isEnabled: false ] ].
	windows do: [ :each |
		menu addItem: [ :item |
			item 
				contents: (self windowMenuItemLabelFor: each);
				icon: (self colorIcon: each model defaultBackgroundColor);
				target: each;
				selector: #comeToFront;
				subMenuUpdater: self
				selector: #windowMenuFor:on:
				arguments: { each };
				action: [ each activateAndForceLabelToShow; expand ] ] ].!

----- Method: TheWorldMainDockingBar>>loadProject (in category 'menu actions') -----
loadProject

	World worldMenu loadProject!

----- Method: TheWorldMainDockingBar>>loadProjectMenuItemOn: (in category 'submenu - projects') -----
loadProjectMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Load Project' translated;
			help: 'Load a project from a file' translated;
			icon: MenuIcons smallLoadProjectIcon;
			target: self;
			selector: #loadProject ]!

----- Method: TheWorldMainDockingBar>>menusOn: (in category 'construction') -----
menusOn: aDockingBar 

	self 
		squeakMenuOn: aDockingBar;
		projectsMenuOn: aDockingBar;
		toolsMenuOn: aDockingBar;
		appsMenuOn: aDockingBar;
		extrasMenuOn: aDockingBar;
		windowsMenuOn: aDockingBar;
		helpMenuOn: aDockingBar.
	aDockingBar addSpacer.
	self
		searchBarOn: aDockingBar;
		clockOn: aDockingBar!

----- Method: TheWorldMainDockingBar>>monticelloBrowserMenuItemOn: (in category 'submenu - tools') -----
monticelloBrowserMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Monticello Browser' translated;
			help: 'Open a Monticello Browser' translated;
			icon: (self colorIcon: MCTool basicNew defaultBackgroundColor);
			target: MCWorkingCopyBrowser;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>monticelloConfigurationsMenuItemOn: (in category 'submenu - tools') -----
monticelloConfigurationsMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Monticello Configurations' translated;
			help: 'Open a Monticello Configurations Editor' translated;
			icon: (self colorIcon: MCConfigurationBrowser basicNew defaultBackgroundColor);
			target: MCConfigurationBrowser;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>newProject: (in category 'menu actions') -----
newProject: projectClass
	"Create a new project of the given type"
	| newProject |
	"Allow the project to return nil from #new to indicate that it was canceled."
	newProject := projectClass new ifNil:[^self].
	ProjectViewMorph openOn: newProject.
	newProject enter.!

----- Method: TheWorldMainDockingBar>>newProjectMenuItemOn: (in category 'submenu - projects') -----
newProjectMenuItemOn: menu

	menu addItem: [ :item | 
		item
			contents: 'New Project' translated;
			help: 'Start a new MorphicProject' translated;
			icon: MenuIcons smallProjectIcon;
			target: self;
			selector: #newProject:;
			arguments: { MorphicProject };
			subMenuUpdater:  self
			selector: #updateNewProjectSubMenu: ]!

----- Method: TheWorldMainDockingBar>>preferenceBrowserMenuItemOn: (in category 'submenu - tools') -----
preferenceBrowserMenuItemOn: menu
	Smalltalk at: #PreferenceBrowser ifPresent:[:pb|
		menu addItem: [ :item |
			item
				contents: 'Preferences' translated;
				help: 'Open a Preferences Browser' translated;
				icon: (self colorIcon: pb basicNew defaultBackgroundColor);
				target: pb;
				selector: #open ]
	].!

----- Method: TheWorldMainDockingBar>>previousProjectMenuItemOn: (in category 'submenu - projects') -----
previousProjectMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Previous Project' translated;
			help: 'Return to the most-recently-visited project' translated;
			icon: MenuIcons smallBackIcon;
			target: World;
			selector: #goBack ]!

----- Method: TheWorldMainDockingBar>>processBrowserMenuItemOn: (in category 'submenu - tools') -----
processBrowserMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Process Browser' translated;
			help: 'Open a Process Browser' translated;
			icon: (self colorIcon: ProcessBrowser basicNew defaultBackgroundColor);
			target: ProcessBrowser;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>projectsMenuOn: (in category 'construction') -----
projectsMenuOn: aDockingBar

	aDockingBar addItem: [ :item |
		item
			contents: 'Projects' translated;
			addSubMenu: [ :menu | 
				self
					newProjectMenuItemOn: menu;
					saveProjectMenuItemOn: menu;
					loadProjectMenuItemOn: menu;
					previousProjectMenuItemOn: menu;
					jumpToProjectMenuItemOn: menu;
					toggleFullScreenMenuItemOn: menu ] ]
!

----- Method: TheWorldMainDockingBar>>quitMenuItemOn: (in category 'submenu - squeak') -----
quitMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Quit' translated;
			help: 'Quit out of Squeak' translated;
			icon: MenuIcons smallQuitIcon;
			target: self;
			selector: #quitSqueak ]!

----- Method: TheWorldMainDockingBar>>quitSqueak (in category 'menu actions') -----
quitSqueak

	^SmalltalkImage current
		snapshot: (
			UserDialogBoxMorph 
				confirm: 'Save changes before quitting?' translated 
				orCancel: [ ^self ]
				at: World center)
		andQuit: true

	!

----- Method: TheWorldMainDockingBar>>save (in category 'menu actions') -----
save

	SmalltalkImage current snapshot: true andQuit: false!

----- Method: TheWorldMainDockingBar>>saveAndQuitMenuItemOn: (in category 'submenu - squeak') -----
saveAndQuitMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Save And Quit' translated;
			help: 'Save the current state of Squeak on disk, and quit out of Squeak' translated;
			icon: MenuIcons smallQuitIcon;
			target: self;
			selector: #saveAndQuitSqueak ]!

----- Method: TheWorldMainDockingBar>>saveAndQuitSqueak (in category 'menu actions') -----
saveAndQuitSqueak

	SmalltalkImage current snapshot: true andQuit: true!

----- Method: TheWorldMainDockingBar>>saveAsMenuItemOn: (in category 'submenu - squeak') -----
saveAsMenuItemOn: menu

	menu addItem: [ :item |	
		item
			contents: 'Save Image As...' translated;
			help: 'Save the current state of Squeak on disk under a new name' translated;
			icon: MenuIcons smallSaveAsIcon;
			target: self;
			selector: #saveImageAs ]!

----- Method: TheWorldMainDockingBar>>saveAsNewVersion (in category 'menu actions') -----
saveAsNewVersion

	SmalltalkImage current saveAsNewVersion!

----- Method: TheWorldMainDockingBar>>saveAsNewVersionMenuItemOn: (in category 'submenu - squeak') -----
saveAsNewVersionMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Save As New Version' translated;
			help: 'Save the current state of Squeak on disk under a version-stamped name' translated;
			icon: MenuIcons smallSaveAsIcon;
			target: self;
			selector: #saveAsNewVersion ]!

----- Method: TheWorldMainDockingBar>>saveImage (in category 'menu actions') -----
saveImage

	SmalltalkImage current saveSession!

----- Method: TheWorldMainDockingBar>>saveImageAs (in category 'menu actions') -----
saveImageAs

	SmalltalkImage current saveAs!

----- Method: TheWorldMainDockingBar>>saveMenuItemOn: (in category 'submenu - squeak') -----
saveMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Save Image' translated;
			help: 'Save the current state of Squeak on disk' translated;
			icon: MenuIcons smallSaveIcon;
			target: self;
			selector: #saveImage ]!

----- Method: TheWorldMainDockingBar>>saveProjectMenuItemOn: (in category 'submenu - projects') -----
saveProjectMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Save Project' translated;
			help: 'Save this project on a file' translated;
			icon: MenuIcons smallPublishIcon;
			target: World;
			selector: #saveOnFile ]!

----- Method: TheWorldMainDockingBar>>searchBarOn: (in category 'right side') -----
searchBarOn: aDockingBar

	aDockingBar 
		addMorphBack: (StringMorph new contents: 'Search: ');
		addMorphBack: SearchBarMorph new;
		addDefaultSpace!

----- Method: TheWorldMainDockingBar>>showSqueakResources (in category 'submenu - help') -----
showSqueakResources
	^(StringHolder new contents:
'Squeak web sites:
	http://www.squeak.org	- The main Squeak site.
	http://news.squeak.org	- The Weekly Squeak
	http://board.squeak.org	- The Squeak Oversight Board
	http://ftp.squeak.org	- Downloads for many Squeak versions.
	http://squeakvm.org	- Development of the Squeak virtual machine
	
Squeak-dev - The main Squeak mailing list.
	http://lists.squeakfoundation.org/mailman/listinfo/squeak-dev
	http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.general
	http://n4.nabble.com/Squeak-Dev-f45488.html

Squeak-Beginners - The place to ask even the most basic questions.
	http://lists.squeakfoundation.org/mailman/listinfo/beginners
	http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.beginners
	http://n4.nabble.com/Squeak-Beginners-f107673.html

Squeak By Example: 
	http://www.squeakbyexample.org/

Squeak, Open Personal Computing and Multimedia (The NuBlue Book - Draft):
	http://coweb.cc.gatech.edu/squeakbook/
	http://stephane.ducasse.free.fr/FreeBooks/CollectiveNBlueBook/

Squeak, Open Personal Computing for Multimedia (The White Book - Draft):
	http://www.cc.gatech.edu/~mark.guzdial/drafts/
	http://stephane.ducasse.free.fr/FreeBooks/GuzdialBookDrafts/

More Books about Squeak and Smalltalk:
	http://stephane.ducasse.free.fr/FreeBooks.html

') openLabel: 'Squeak Online Resources'!

----- Method: TheWorldMainDockingBar>>showWelcomeText:label:in: (in category 'submenu - help') -----
showWelcomeText: aSelector label: labelString in: bounds
	"Show a welcome text. Linked in here so that the text can be edited
	by changing the acceptBlock below."
	| acceptBlock window |
	"Change the following to allow editing the text"
	true ifTrue:[
		acceptBlock := [:text|
			self class
				compile: aSelector,'
	^', (String streamContents:[:s| s nextChunkPutWithStyle: text]) storeString, ' readStream nextChunkText'
				classified: (self class organization categoryOfElement: aSelector).
		].
	].

	window := UIManager default 
		edit: (self perform: aSelector)
		label: labelString
		accept: acceptBlock.
	window bounds: bounds.
!

----- Method: TheWorldMainDockingBar>>simpleChangeSorterMenuItemOn: (in category 'submenu - tools') -----
simpleChangeSorterMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Simple Change Sorter' translated;
			help: 'Open a Change Sorter' translated;
			icon: (self colorIcon: ChangeSorter basicNew defaultBackgroundColor);
			target: ChangeSorter;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>squeakMenuOn: (in category 'construction') -----
squeakMenuOn: aDockingBar 
	"Private - fill the given docking bar"
	
	aDockingBar addItem: [ :item |
		item
			contents: '';
			icon: MenuIcons squeakLogoIcon;
			selectedIcon: MenuIcons squeakLogoInvertedIcon;
			addSubMenu: [ :menu | 
				self
					aboutMenuItemOn: menu;
					updateMenuItemOn: menu.
				menu addLine.
				self 
					saveMenuItemOn: menu;
					saveAsMenuItemOn: menu;
					saveAsNewVersionMenuItemOn: menu.
				menu addLine.
				self
					saveAndQuitMenuItemOn: menu;
					quitMenuItemOn: menu ] ]!

----- Method: TheWorldMainDockingBar>>squeakOnlineResources (in category 'submenu - help') -----
squeakOnlineResources
	^'Squeak web sites
	http://www.squeak.org	- The main Squeak site.
	http://news.squeak.org	- The Weekly Squeak
	http://board.squeak.org	- The Squeak Oversight Board
	http://ftp.squeak.org	- Downloads for many Squeak versions.
	http://squeakvm.org	- Development of the Squeak virtual machine
	
Squeak-dev - The main Squeak mailing list
	http://lists.squeakfoundation.org/mailman/listinfo/squeak-dev
	http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.general
	http://n4.nabble.com/Squeak-Dev-f45488.html

Squeak-Beginners - The place to ask even the most basic questions
	http://lists.squeakfoundation.org/mailman/listinfo/beginners
	http://dir.gmane.org/gmane.comp.lang.smalltalk.squeak.beginners
	http://n4.nabble.com/Squeak-Beginners-f107673.html

Squeak By Example
	http://www.squeakbyexample.org/

Squeak, Open Personal Computing and Multimedia
	http://coweb.cc.gatech.edu/squeakbook/
	http://stephane.ducasse.free.fr/FreeBooks/CollectiveNBlueBook/

Squeak, Open Personal Computing for Multimedia
	http://www.cc.gatech.edu/~mark.guzdial/drafts/
	http://stephane.ducasse.free.fr/FreeBooks/GuzdialBookDrafts/

More Books about Squeak and Smalltalk
	http://stephane.ducasse.free.fr/FreeBooks.html
!!
]style[(16 274 41 173 65 181 17 35 46 106 46 112 37 49)bu,,bu,,bu,,bu,,bu,,bu,,bu,!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>squeakUserInterface (in category 'submenu - help') -----
squeakUserInterface
	^'The Squeak UI has some unusual elements that you may not have seen before.  Here is a brief introduction to those elements:

Projects
A project is an entire Squeak desktop full of windows.  Projects can be used to change quickly from one task to another.  An inactive project is represented by a project window, which shows a thumbnail of its state.  Project windows are actually more like doors than windows, since you can enter the project just by clicking on them.  You can create a new project by choosing ''open...project'' from the screen menu.  To exit a project (and return to its parent project), choose ''previous project'' from the screen menu.  Each project maintains its own set of windows and other information.

Morphic Halos
In a morphic project, pressing cmd-click (Mac) or alt-click (Windows) on a graphical object (e.g. a window) will surround it with a constellation of colored circles.  These are called "halo handles."  Additional clicks will cycle through the halos for the other graphical objects in the nesting structure.  If you hold down the Shift key while cmd/alt-clicking, the nested morphs will be traversed from innermost outward.  Clicking without the cmd/alt key will dismiss the halo.  While the halo is up, letting the cursor linger over one of the halo handles for a few seconds will cause a balloon to pop up with the name of that handle.  Three useful handles are the top-left "X" handle (delete), the bottom-right yellow handle (resize), and the brown handle (slide the object within its containing object).  Halos allow complex graphical objects to be explored - or even disassembled (using the black halo handle).  Usually no harm results from taking apart an object; you can just discard the pieces and create a new one.

Flaps
To enable Flaps, click on the desktop to show the world menu, choose the "Flaps..." menu and "show shared tags". Tabs labeled "Squeak", "Tools", "Supplies", etc., will appear along the edges of the Squeak desktop.  Click on any tab to open the corresponding flap.  Drag a tab to resize the flap and to relocate the tab.  Bring up the halo on any tab and click on its menu handle to be presented with many options relating to the flap.  Use the "Flaps..." menu, reached via the desktop menu, to control which flaps are visible and for other flap-related options and assistance.

Parts Bins
You can obtain new objects in many ways.  The "Objects Catalog" (choose "objects'' from the world menu or open the objects flap) and several of the standard flaps (e.g. "Tools" and "Supplies") serve as "Parts Bins" the for new objects.  Drag any icon you see in a Parts Bin and a fresh copy of the kind of object it represents will appear "in your hand"; click to deposit the new object anywhere you wish.  You can also add your own objects to any of the flaps - just drag your object over the tab, wait for the flap to pop open, then drop the object at the desired position in the flap.
!!
]style[(123 9 663 13 991 5 579 10 589),bu,,bu,,bu,,bu,!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>startMessageTally (in category 'menu actions') -----
startMessageTally
	(self confirm: 'MessageTally will start now,
and stop when the cursor goes
to the top of the screen') ifTrue:
		[MessageTally spyOn:
			[[Sensor peekMousePt y > 0] whileTrue: [World doOneCycle]]]!

----- Method: TheWorldMainDockingBar>>terseGuideToSqueak (in category 'submenu - help') -----
terseGuideToSqueak
	^'Terse Guide to Squeak
by Chris Rathman (http://www.angelfire.com/tx4/cus/notes/smalltalk.html)
as reported in http://wiki.squeak.org/squeak/5699

Allowable characters
- a-z
- A-Z
- 0-9
- . Nothing more expected ->+/\*~<>@%|&?
- blank, tab, cr, ff, lf
 
Variables
- variables must be declared before use
- shared vars must begin with uppercase
- local vars must begin with lowercase
- reserved names: nil, true, false, self, super, and Smalltalk

Variable scope
- Global: defined in Dictionary Smalltalk and accessible by all
         objects in system
- Special: (reserved) Smalltalk, super, self, true, false, & nil
- Method Temporary: local to a method
- Block Temporary: local to a block
- Pool: variables in a Dictionary object
- Method Parameters: automatic local vars created as a result of
         message call with params
- Block Parameters: automatic local vars created as a result of
         value: message call
- Class: shared with all instances of one class & its subclasses
- Class Instance: unique to each instance of a class
- Instance Variables: unique to each instance

Comments are "enclosed in quotes"
Period (.) is the statement seperator.

Code Snippets
Just select and Do-it/Print-it.
(variables are automatically created when needed)

Transcript
Transcript clear.                                           "clear to transcript window"
Transcript show: ''Hello World''.                             "output string in transcript window"
Transcript nextPutAll: ''Hello World''.                       "output string in transcript window"
Transcript nextPut: $A.                                     "output character in transcript window"
Transcript space.                                           "output space character in transcript window"
Transcript tab.                                             "output tab character in transcript window"
Transcript cr.                                              "carriage return / linefeed"
''Hello'' printOn: Transcript.                                "append print string into the window"
''Hello'' storeOn: Transcript.                                "append store string into the window"
Transcript endEntry.                                        "flush the output buffer"

Assignment
x _ 4.                                                      "assignment (Squeak) <-"
x := 5.                                                     "assignment"
x := y := z := 6.                                           "compound assignment"
x := (y := 6) + 1.
x := Object new.                                            "bind to allocated instance of a class"
x := 123 class.                                             "discover the object class"
x := Integer superclass.                                    "discover the superclass of a class"
x := Object allInstances.                                   "get an array of all instances of a class"
x := Integer allSuperclasses.                               "get all superclasses of a class"
x := 1.2 hash.                                              "hash value for object"
y := x copy.                                                "copy object"
y := x shallowCopy.                                         "copy object (not overridden)"
y := x deepCopy.                                            "copy object and instance vars"
y := x veryDeepCopy.                                        "complete tree copy using a dictionary"

Constants
b := true.                                                  "true constant"
b := false.                                                 "false constant"
x := nil.                                                   "nil object constant"
x := 1.                                                     "integer constants"
x := 3.14.                                                  "float constants"
x := 2e-2.                                                  "fractional constants"
x := 16r0F.                                                 "hex constant".
x := -1.                                                    "negative constants"
x := ''Hello''.                                               "string constant"
x := ''I''''m here''.                                           "single quote escape"
x := $A.                                                    "character constant"
x := $ .                                                    "character constant (space)"
x := #aSymbol.                                              "symbol constants"
x := #(3 2 1).                                              "array constants"
x := #(''abc'' 2 $a).                                         "mixing of types allowed"

Booleans
x := 1. y := 2.
b := (x = y).                                               "equals"
b := (x ~= y).                                              "not equals"
b := (x == y).                                              "identical"
b := (x ~~ y).                                              "not identical"
b := (x > y).                                               "greater than"
b := (x < y).                                               "less than"
b := (x >= y).                                              "greater than or equal"
b := (x <= y).                                              "less than or equal"
b := b not.                                                 "boolean not"
b := (x < 5) & (y > 1).                                     "boolean and"
b := (x < 5) | (y > 1).                                     "boolean or"
b := (x < 5) and: [y > 1].                                  "boolean and (short-circuit)"
b := (x < 5) or: [y > 1].                                   "boolean or (short-circuit)"
b := (x < 5) eqv: (y > 1).                                  "test if both true or both false"
b := (x < 5) xor: (y > 1).                                  "test if one true and other false"
b := 5 between: 3 and: 12.                                  "between (inclusive)"
b := 123 isKindOf: Number.                                  "test if object is class or subclass of"
b := 123 isMemberOf: SmallInteger.                          "test if object is type of class"
b := 123 respondsTo: sqrt.                                  "test if object responds to message"
b := x isNil.                                               "test if object is nil"
b := x isZero.                                              "test if number is zero"
b := x positive.                                            "test if number is positive"
b := x strictlyPositive.                                    "test if number is greater than zero"
b := x negative.                                            "test if number is negative"
b := x even.                                                "test if number is even"
b := x odd.                                                 "test if number is odd"
b := x isLiteral.                                           "test if literal constant"
b := x isInteger.                                           "test if object is integer"
b := x isFloat.                                             "test if object is float"
b := x isNumber.                                            "test if object is number"
b := $A isUppercase.                                        "test if upper case character"
b := $A isLowercase.                                        "test if lower case character"

Arithmetic expressions
x := 6 + 3.                                                 "addition"
x := 6 - 3.                                                 "subtraction"
x := 6 * 3.                                                 "multiplication"
x := 1 + 2 * 3.                                             "evaluation always left to right (1 + 2) * 3"
x := 5 / 3.                                                 "division with fractional result"
x := 5.0 / 3.0.                                             "division with float result"
x := 5.0 // 3.0.                                            "integer divide"
x := 5.0 \\ 3.0.                                            "integer remainder"
x := -5.                                                    "unary minus"
x := 5 sign.                                                "numeric sign (1, -1 or 0)"
x := 5 negated.                                             "negate receiver"
x := 1.2 integerPart.                                       "integer part of number (1.0)"
x := 1.2 fractionPart.                                      "fractional part of number (0.2)"
x := 5 reciprocal.                                          "reciprocal function"
x := 6 * 3.1.                                               "auto convert to float"
x := 5 squared.                                             "square function"
x := 25 sqrt.                                               "square root"
x := 5 raisedTo: 2.                                         "power function"
x := 5 raisedToInteger: 2.                                  "power function with integer"
x := 5 exp.                                                 "exponential"
x := -5 abs.                                                "absolute value"
x := 3.99 rounded.                                          "round"
x := 3.99 truncated.                                        "truncate"
x := 3.99 roundTo: 1.                                       "round to specified decimal places"
x := 3.99 truncateTo: 1.                                    "truncate to specified decimal places"
x := 3.99 floor.                                            "truncate"
x := 3.99 ceiling.                                          "round up"
x := 5 factorial.                                           "factorial"
x := -5 quo: 3.                                             "integer divide rounded toward zero"
x := -5 rem: 3.                                             "integer remainder rounded toward zero"
x := 28 gcd: 12.                                            "greatest common denominator"
x := 28 lcm: 12.                                            "least common multiple"
x := 100 ln.                                                "natural logarithm"
x := 100 log.                                               "base 10 logarithm"
x := 100 log: 10.                                           "logarithm with specified base"
x := 100 floorLog: 10.                                      "floor of the log"
x := 180 degreesToRadians.                                  "convert degrees to radians"
x := 3.14 radiansToDegrees.                                 "convert radians to degrees"
x := 0.7 sin.                                               "sine"
x := 0.7 cos.                                               "cosine"
x := 0.7 tan.                                               "tangent"
x := 0.7 arcSin.                                            "arcsine"
x := 0.7 arcCos.                                            "arccosine"
x := 0.7 arcTan.                                            "arctangent"
x := 10 max: 20.                                            "get maximum of two numbers"
x := 10 min: 20.                                            "get minimum of two numbers"
x := Float pi.                                              "pi"
x := Float e.                                               "exp constant"
x := Float infinity.                                        "infinity"
x := Float nan.                                             "not-a-number"
x := Random new next; yourself. x next.                     "random number stream (0.0 to 1.0)
x := 100 atRandom.                                          "quick random number"

Bitwise Manipulation
x := 16rFF bitAnd: 16r0F.                                   "and bits"
x := 16rF0 bitOr: 16r0F.                                    "or bits"
x := 16rFF bitXor: 16r0F.                                   "xor bits"
x := 16rFF bitInvert.                                       "invert bits"
x := 16r0F bitShift: 4.                                     "left shift"
x := 16rF0 bitShift: -4.                                    "right shift"
"x := 16r80 bitAt: 7."                                      "bit at position (0|1) [!!!!Squeak]"
x := 16r80 highbit.                                         "position of highest bit set"
b := 16rFF allMask: 16r0F.                                  "test if all bits set in mask set in receiver"
b := 16rFF anyMask: 16r0F.                                  "test if any bits set in mask set in receiver"
b := 16rFF noMask: 16r0F.                                   "test if all bits set in mask clear in receiver"

Conversion
x := 3.99 asInteger.                                        "convert number to integer (truncates in Squeak)"
x := 3.99 asFraction.                                       "convert number to fraction"
x := 3 asFloat.                                             "convert number to float"
x := 65 asCharacter.                                        "convert integer to character"
x := $A asciiValue.                                         "convert character to integer"
x := 3.99 printString.                                      "convert object to string via printOn:"
x := 3.99 storeString.                                      "convert object to string via storeOn:"
x := 15 radix: 16.                                          "convert to string in given base"
x := 15 printStringBase: 16.
x := 15 storeStringBase: 16.

Blocks
- blocks are objects and may be assigned to a variable
- value is last expression evaluated unless explicit return
- blocks may be nested
- specification [ arguments | | localvars | expressions ]
- max of three arguments allowed
- ^expression terminates block & method (exits all nested blocks)
- blocks intended for long term storage should not contain ^

x := [ y := 1. z := 2. ]. x value.                          "simple block usage"
x := [ :argOne :argTwo |   argOne, '' and '' , argTwo.].      "set up block with argument passing"
Transcript show: (x value: ''First'' value: ''Second''); cr.    "use block with argument passing"
"x := [ | z | z := 1.].                                      localvars not available in squeak blocks"

Method calls
- unary methods are messages with no arguments
- binary methods
- keyword methods are messages with selectors including colons

standard categories/protocols
- initialize-release    (methods called for new instance)
- accessing             (get/set methods)
- testing               (boolean tests - is)
- comparing             (boolean tests with parameter
- displaying            (gui related methods)
- printing              (methods for printing)
- updating              (receive notification of changes)
- private               (methods private to class)
- instance-creation     (class methods for creating instance)

x := 2 sqrt.                                                "unary message"
x := 2 raisedTo: 10.                                        "keyword message"
x := 194 * 9.                                               "binary message"
Transcript show: (194 * 9) printString; cr.                 "combination (chaining)"
x := 2 perform: #sqrt.                                      "indirect method invocation"
Transcript                                                  "Cascading - send multiple messages to receiver"
   show: ''hello '';
   show: ''world'';
   cr.
x := 3 + 2; * 100.                                          "result=300. Sends message to same receiver (3)"

Conditional Statements
x > 10 ifTrue: [Transcript show: ''ifTrue''; cr].             "if then"
x > 10 ifFalse: [Transcript show: ''ifFalse''; cr].           "if else"
x > 10                                                      "if then else"
   ifTrue: [Transcript show: ''ifTrue''; cr]
   ifFalse: [Transcript show: ''ifFalse''; cr].
x > 10                                                      "if else then"
   ifFalse: [Transcript show: ''ifFalse''; cr]
   ifTrue: [Transcript show: ''ifTrue''; cr].
Transcript
   show:
      (x > 10
         ifTrue: [''ifTrue'']
         ifFalse: [''ifFalse'']);
   cr.
Transcript                                                  "nested if then else"
   show:
      (x > 10
         ifTrue: [x > 5
            ifTrue: [''A'']
            ifFalse: [''B'']]
         ifFalse: [''C'']);
   cr.
switch := Dictionary new.                                   "switch functionality"
switch at: $A put: [Transcript show: ''Case A''; cr].
switch at: $B put: [Transcript show: ''Case B''; cr].
switch at: $C put: [Transcript show: ''Case C''; cr].
result := (switch at: $B) value.

Iteration statements
x := 4. y := 1.
[x > 0] whileTrue: [x := x - 1. y := y * 2].                "while true loop"
[x >= 4] whileFalse: [x := x + 1. y := y * 2].              "while false loop"
x timesRepeat: [y := y * 2].                                "times repear loop (i := 1 to x)"
1 to: x do: [:a | y := y * 2].                              "for loop"
1 to: x by: 2 do: [:a | y := y / 2].                        "for loop with specified increment"
#(5 4 3) do: [:a | x := x + a].                             "iterate over array elements"

Character
| x y |
x := $A.                                                    "character assignment"
y := x isLowercase.                                         "test if lower case"
y := x isUppercase.                                         "test if upper case"
y := x isLetter.                                            "test if letter"
y := x isDigit.                                             "test if digit"
y := x isAlphaNumeric.                                      "test if alphanumeric"
y := x isSeparator.                                         "test if seperator char"
y := x isVowel.                                             "test if vowel"
y := x digitValue.                                          "convert to numeric digit value"
y := x asLowercase.                                         "convert to lower case"
y := x asUppercase.                                         "convert to upper case"
y := x asciiValue.                                          "convert to numeric ascii value"
y := x asString.                                            "convert to string"
b := $A <= $B.                                              "comparison"
y := $A max: $B.

Symbol
x := #Hello.                                                "symbol assignment"
y := ''String'', ''Concatenation''.                             "symbol concatenation (result is string)"
b := x isEmpty.                                             "test if symbol is empty"
y := x size.                                                "string size"
y := x at: 2.                                               "char at location"
y := x copyFrom: 2 to: 4.                                   "substring"
y := x indexOf: $e ifAbsent: [0].                           "first position of character within string"
x do: [:a | Transcript show: a printString; cr].            "iterate over the string"
b := x conform: [:a | (a >= $a) & (a <= $z)].               "test if all elements meet condition"
y := x select: [:a | a > $a].                               "return all elements that meet condition"
y := x asString.                                            "convert symbol to string"
y := x asText.                                              "convert symbol to text"
y := x asArray.                                             "convert symbol to array"
y := x asOrderedCollection.                                 "convert symbol to ordered collection"
y := x asSortedCollection.                                  "convert symbol to sorted collection"
y := x asBag.                                               "convert symbol to bag collection"
y := x asSet.                                               "convert symbol to set collection"

String
x := ''This is a string''.                                    "string assignment"
x := ''String'', ''Concatenation''.                             "string concatenation"
b := x isEmpty.                                             "test if string is empty"
y := x size.                                                "string size"
y := x at: 2.                                               "char at location"
y := x copyFrom: 2 to: 4.                                   "substring"
y := x indexOf: $a ifAbsent: [0].                           "first position of character within string"
x := String new: 4.                                         "allocate string object"
x                                                           "set string elements"
   at: 1 put: $a;
   at: 2 put: $b;
   at: 3 put: $c;
   at: 4 put: $e.
x := String with: $a with: $b with: $c with: $d.            "set up to 4 elements at a time"
x do: [:a | Transcript show: a printString; cr].            "iterate over the string"
b := x conform: [:a | (a >= $a) & (a <= $z)].               "test if all elements meet condition"
y := x select: [:a | a > $a].                               "return all elements that meet condition"
y := x asSymbol.                                            "convert string to symbol"
y := x asArray.                                             "convert string to array"
x := ''ABCD'' asByteArray.                                    "convert string to byte array"
y := x asOrderedCollection.                                 "convert string to ordered collection"
y := x asSortedCollection.                                  "convert string to sorted collection"
y := x asBag.                                               "convert string to bag collection"
y := x asSet.                                               "convert string to set collection"
y := x shuffled.                                            "randomly shuffle string"

Arrays
Array:			Fixed length collection
ByteArray:		Array limited to byte elements (0-255)
WordArray:	Array limited to word elements (0-2^32)

x := #(4 3 2 1).                                            "constant array"
x := Array with: 5 with: 4 with: 3 with: 2.                 "create array with up to 4 elements"
x := Array new: 4.                                          "allocate an array with specified size"
x                                                           "set array elements"
   at: 1 put: 5;
   at: 2 put: 4;
   at: 3 put: 3;
   at: 4 put: 2.
b := x isEmpty.                                             "test if array is empty"
y := x size.                                                "array size"
y := x at: 4.                                               "get array element at index"
b := x includes: 3.                                         "test if element is in array"
y := x copyFrom: 2 to: 4.                                   "subarray"
y := x indexOf: 3 ifAbsent: [0].                            "first position of element within array"
y := x occurrencesOf: 3.                                    "number of times object in collection"
x do: [:a | Transcript show: a printString; cr].            "iterate over the array"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum array elements"
sum := 0. 1 to: (x size) do: [:a | sum := sum + (x at: a)]. "sum array elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum array elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in array"
   ifTrue: [a]
   ifFalse: [c]].
y := x shuffled.                                            "randomly shuffle collection"
y := x asArray.                                             "convert to array"
"y := x asByteArray."                                       "note: this instruction not available on Squeak"
y := x asWordArray.                                         "convert to word array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

OrderedCollection: acts like an expandable array
x := OrderedCollection with: 4 with: 3 with: 2 with: 1.     "create collection with up to 4 elements"
x := OrderedCollection new.                                 "allocate collection"
x add: 3; add: 2; add: 1; add: 4; yourself.                 "add element to collection"
y := x addFirst: 5.                                         "add element at beginning of collection"
y := x removeFirst.                                         "remove first element in collection"
y := x addLast: 6.                                          "add element at end of collection"
y := x removeLast.                                          "remove last element in collection"
y := x addAll: #(7 8 9).                                    "add multiple elements to collection"
y := x removeAll: #(7 8 9).                                 "remove multiple elements from collection"
x at: 2 put: 3.                                             "set element at index"
y := x remove: 5 ifAbsent: [].                              "remove element from collection"
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
y := x at: 2.                                               "retrieve element at index"
y := x first.                                               "retrieve first element in collection"
y := x last.                                                "retrieve last element in collection"
b := x includes: 5.                                         "test if element is in collection"
y := x copyFrom: 2 to: 3.                                   "subcollection"
y := x indexOf: 3 ifAbsent: [0].                            "first position of element within collection"
y := x occurrencesOf: 3.                                    "number of times object in collection"
x do: [:a | Transcript show: a printString; cr].            "iterate over the collection"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := 0. 1 to: (x size) do: [:a | sum := sum + (x at: a)]. "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x shuffled.                                            "randomly shuffle collection"
y := x asArray.                                             "convert to array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

SortedCollection:	like OrderedCollection except order of elements
 					determined by sorting criteria
x := SortedCollection with: 4 with: 3 with: 2 with: 1.      "create collection with up to 4 elements"
x := SortedCollection new.                                  "allocate collection"
x := SortedCollection sortBlock: [:a :c | a > c].           "set sort criteria"
x add: 3; add: 2; add: 1; add: 4; yourself.                 "add element to collection"
y := x addFirst: 5.                                         "add element at beginning of collection"
y := x removeFirst.                                         "remove first element in collection"
y := x addLast: 6.                                          "add element at end of collection"
y := x removeLast.                                          "remove last element in collection"
y := x addAll: #(7 8 9).                                    "add multiple elements to collection"
y := x removeAll: #(7 8 9).                                 "remove multiple elements from collection"
y := x remove: 5 ifAbsent: [].                              "remove element from collection"
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
y := x at: 2.                                               "retrieve element at index"
y := x first.                                               "retrieve first element in collection"
y := x last.                                                "retrieve last element in collection"
b := x includes: 4.                                         "test if element is in collection"
y := x copyFrom: 2 to: 3.                                   "subcollection"
y := x indexOf: 3 ifAbsent: [0].                            "first position of element within collection"
y := x occurrencesOf: 3.                                    "number of times object in collection"
x do: [:a | Transcript show: a printString; cr].            "iterate over the collection"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := 0. 1 to: (x size) do: [:a | sum := sum + (x at: a)]. "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x asArray.                                             "convert to array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

Bag:	like OrderedCollection except elements are in no particular order
x := Bag with: 4 with: 3 with: 2 with: 1.                   "create collection with up to 4 elements"
x := Bag new.                                               "allocate collection"
x add: 4; add: 3; add: 1; add: 2; yourself.                 "add element to collection"
x add: 3 withOccurrences: 2.                                "add multiple copies to collection"
y := x addAll: #(7 8 9).                                    "add multiple elements to collection"
y := x removeAll: #(7 8 9).                                 "remove multiple elements from collection"
y := x remove: 4 ifAbsent: [].                              "remove element from collection"
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
b := x includes: 3.                                         "test if element is in collection"
y := x occurrencesOf: 3.                                    "number of times object in collection"
x do: [:a | Transcript show: a printString; cr].            "iterate over the collection"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

Sets
Set:			like Bag except duplicates not allowed
IdentitySet:	uses identity test (== rather than =)

x := Set with: 4 with: 3 with: 2 with: 1.                   "create collection with up to 4 elements"
x := Set new.                                               "allocate collection"
x add: 4; add: 3; add: 1; add: 2; yourself.                 "add element to collection"
y := x addAll: #(7 8 9).                                    "add multiple elements to collection"
y := x removeAll: #(7 8 9).                                 "remove multiple elements from collection"
y := x remove: 4 ifAbsent: [].                              "remove element from collection"
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
x includes: 4.                                              "test if element is in collection"
x do: [:a | Transcript show: a printString; cr].            "iterate over the collection"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x asArray.                                             "convert to array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

Interval
x := Interval from: 5 to: 10.                               "create interval object"
x := 5 to: 10.
x := Interval from: 5 to: 10 by: 2.                         "create interval object with specified increment"
x := 5 to: 10 by: 2.
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
x includes: 9.                                              "test if element is in collection"
x do: [:k | Transcript show: k printString; cr].            "iterate over interval"
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 7].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := 0. 1 to: (x size) do: [:a | sum := sum + (x at: a)]. "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x asArray.                                             "convert to array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

Associations
x := #myVar->''hello''.
y := x key.
y := x value.

Dictionary
IdentityDictionary:   uses identity test (== rather than =)
x := Dictionary new.                                        "allocate collection"
x add: #a->4; add: #b->3; add: #c->1; add: #d->2; yourself. "add element to collection"
x at: #e put: 3.                                            "set element at index"
b := x isEmpty.                                             "test if empty"
y := x size.                                                "number of elements"
y := x at: #a ifAbsent: [].                                 "retrieve element at index"
y := x keyAtValue: 3 ifAbsent: [].                          "retrieve key for given value with error block"
y := x removeKey: #e ifAbsent: [].                          "remove element from collection"
b := x includes: 3.                                         "test if element is in values collection"
b := x includesKey: #a.                                     "test if element is in keys collection"
y := x occurrencesOf: 3.                                    "number of times object in collection"
y := x keys.                                                "set of keys"
y := x values.                                              "bag of values"
x do: [:a | Transcript show: a printString; cr].            "iterate over the values collection"
x keysDo: [:a | Transcript show: a printString; cr].        "iterate over the keys collection"
x associationsDo: [:a | Transcript show: a printString; cr]."iterate over the associations"
x keysAndValuesDo: [:aKey :aValue | Transcript              "iterate over keys and values"
   show: aKey printString; space;
   show: aValue printString; cr].
b := x conform: [:a | (a >= 1) & (a <= 4)].                 "test if all elements meet condition"
y := x select: [:a | a > 2].                                "return collection of elements that pass test"
y := x reject: [:a | a < 2].                                "return collection of elements that fail test"
y := x collect: [:a | a + a].                               "transform each element for new collection"
y := x detect: [:a | a > 3] ifNone: [].                     "find position of first element that passes test"
sum := 0. x do: [:a | sum := sum + a]. sum.                 "sum elements"
sum := x inject: 0 into: [:a :c | a + c].                   "sum elements"
max := x inject: 0 into: [:a :c | (a > c)                   "find max element in collection"
   ifTrue: [a]
   ifFalse: [c]].
y := x asArray.                                             "convert to array"
y := x asOrderedCollection.                                 "convert to ordered collection"
y := x asSortedCollection.                                  "convert to sorted collection"
y := x asBag.                                               "convert to bag collection"
y := x asSet.                                               "convert to set collection"

Smalltalk at: #CMRGlobal put: ''CMR entry''.                  "put global in Smalltalk Dictionary"
x := Smalltalk at: #CMRGlobal.                              "read global from Smalltalk Dictionary"
Transcript show: (CMRGlobal printString).                   "entries are directly accessible by name"
Smalltalk keys do: [ :k |                                   "print out all classes"
   ((Smalltalk at: k) isKindOf: Class)
      ifFalse: [Transcript show: k printString; cr]].
Smalltalk at: #CMRDictionary put: (Dictionary new).         "set up user defined dictionary"
CMRDictionary at: #MyVar1 put: ''hello1''.                    "put entry in dictionary"
CMRDictionary add: #MyVar2->''hello2''.                       "add entry to dictionary use key->value combo"
CMRDictionary size.                                         "dictionary size"
CMRDictionary keys do: [ :k |                               "print out keys in dictionary"
   Transcript show: k printString; cr].
CMRDictionary values do: [ :k |                             "print out values in dictionary"
   Transcript show: k printString; cr].
CMRDictionary keysAndValuesDo: [:aKey :aValue |             "print out keys and values"
   Transcript
      show: aKey printString;
      space;
      show: aValue printString;
      cr].
CMRDictionary associationsDo: [:aKeyValue |                 "another iterator for printing key values"
   Transcript show: aKeyValue printString; cr].
Smalltalk removeKey: #CMRGlobal ifAbsent: [].               "remove entry from Smalltalk dictionary"
Smalltalk removeKey: #CMRDictionary ifAbsent: [].           "remove user dictionary from Smalltalk dictionary"

Streams
Internal Stream
ios := ReadStream on: ''Hello read stream''.
ios := ReadStream on: ''Hello read stream'' from: 1 to: 5.
[(x := ios nextLine) notNil]
   whileTrue: [Transcript show: x; cr].
ios position: 3.
ios position.
x := ios next.
x := ios peek.
x := ios contents.
b := ios atEnd.

ios := ReadWriteStream on: ''Hello read stream''.
ios := ReadWriteStream on: ''Hello read stream'' from: 1 to: 5.
ios := ReadWriteStream with: ''Hello read stream''.
ios := ReadWriteStream with: ''Hello read stream'' from: 1 to: 10.
ios position: 0.
[(x := ios nextLine) notNil]
   whileTrue: [Transcript show: x; cr].
ios position: 6.
ios position.
ios nextPutAll: ''Chris''.
x := ios next.
x := ios peek.
x := ios contents.
b := ios atEnd.

FileStream
ios := FileStream newFileNamed: ''ios.txt''.
ios nextPut: $H; cr.
ios nextPutAll: ''Hello File''; cr.
''Hello File'' printOn: ios.
''Hello File'' storeOn: ios.
ios close.

ios := FileStream oldFileNamed: ''ios.txt''.
[(x := ios nextLine) notNil]
   whileTrue: [Transcript show: x; cr].
ios position: 3.
x := ios position.
x := ios next.
x := ios peek.
b := ios atEnd.
ios close.

Date
x := Date today.                                            "create date for today"
x := Date dateAndTimeNow.                                   "create date from current time/date"
x := Date readFromString: ''01/02/1999''.                     "create date from formatted string"
x := Date newDay: 12 month: #July year: 1999                "create date from parts"
x := Date fromDays: 36000.                                  "create date from elapsed days since 1/1/1901"
y := Date dayOfWeek: #Monday.                               "day of week as int (1-7)"
y := Date indexOfMonth: #January.                           "month of year as int (1-12)"
y := Date daysInMonth: 2 forYear: 1996.                     "day of month as int (1-31)"
y := Date daysInYear: 1996.                                 "days in year (365|366)"
y := Date nameOfDay: 1                                      "weekday name (#Monday,...)"
y := Date nameOfMonth: 1.                                   "month name (#January,...)"
y := Date leapYear: 1996.                                   "1 if leap year; 0 if not leap year"
y := x weekday.                                             "day of week (#Monday,...)"
y := x previous: #Monday.                                   "date for previous day of week"
y := x dayOfMonth.                                          "day of month (1-31)"
y := x day.                                                 "day of year (1-366)"
y := x firstDayOfMonth.                                     "day of year for first day of month"
y := x monthName.                                           "month of year (#January,...)"
y := x monthIndex.                                          "month of year (1-12)"
y := x daysInMonth.                                         "days in month (1-31)"
y := x year.                                                "year (19xx)"
y := x daysInYear.                                          "days in year (365|366)"
y := x daysLeftInYear.                                      "days left in year (364|365)"
y := x asSeconds.                                           "seconds elapsed since 1/1/1901"
y := x addDays: 10.                                         "add days to date object"
y := x subtractDays: 10.                                    "subtract days to date object"
y := x subtractDate: (Date today).                          "subtract date (result in days)"
y := x printFormat: #(2 1 3 $/ 1 1).                        "print formatted date"
b := (x <= Date today).                                     "comparison"

Time
x := Time now.                                              "create time from current time"
x := Time dateAndTimeNow.                                   "create time from current time/date"
x := Time readFromString: ''3:47:26 pm''.                     "create time from formatted string"
x := Time fromSeconds: (60 * 60 * 4).                       "create time from elapsed time from midnight"
y := Time millisecondClockValue.                            "milliseconds since midnight"
y := Time totalSeconds.                                     "total seconds since 1/1/1901"
y := x seconds.                                             "seconds past minute (0-59)"
y := x minutes.                                             "minutes past hour (0-59)"
y := x hours.                                               "hours past midnight (0-23)"
y := x addTime: (Time now).                                 "add time to time object"
y := x subtractTime: (Time now).                            "subtract time to time object"
y := x asSeconds.                                           "convert time to seconds"
x := Time millisecondsToRun: [                              "timing facility"
   1 to: 1000 do: [:index | y := 3.14 * index]].
b := (x <= Time now).                                       "comparison"

Point
x := 200 at 100.                                               "obtain a new point"
y := x x.                                                   "x coordinate"
y := x y.                                                   "y coordinate"
x := 200 at 100 negated.                                       "negates x and y"
x := (-200 at -100) abs.                                       "absolute value of x and y"
x := (200.5 at 100.5) rounded.                                 "round x and y"
x := (200.5 at 100.5) truncated.                               "truncate x and y"
x := 200 at 100 + 100.                                         "add scale to both x and y"
x := 200 at 100 - 100.                                         "subtract scale from both x and y"
x := 200 at 100 * 2.                                           "multiply x and y by scale"
x := 200 at 100 / 2.                                           "divide x and y by scale"
x := 200 at 100 // 2.                                          "divide x and y by scale"
x := 200 at 100 \\ 3.                                          "remainder of x and y by scale"
x := 200 at 100 + 50 at 25.                                       "add points"
x := 200 at 100 - 50 at 25.                                       "subtract points"
x := 200 at 100 * 3 at 4.                                         "multiply points"
x := 200 at 100 // 3 at 4.                                        "divide points"
x := 200 at 100 max: 50 at 200.                                   "max x and y"
x := 200 at 100 min: 50 at 200.                                   "min x and y"
x := 20 at 5 dotProduct: 10 at 2.                                 "sum of product (x1*x2 + y1*y2)"

Rectangle
Rectangle fromUser.

Pen
Display restoreAfter: [
   Display fillWhite.

myPen := Pen new.                                           "get graphic pen"
myPen squareNib: 1.
myPen color: (Color blue).                                  "set pen color"
myPen home.                                                 "position pen at center of display"
myPen up.                                                   "makes nib unable to draw"
myPen down.                                                 "enable the nib to draw"
myPen north.                                                "points direction towards top"
myPen turn: -180.                                           "add specified degrees to direction"
myPen direction.                                            "get current angle of pen"
myPen go: 50.                                               "move pen specified number of pixels"
myPen location.                                             "get the pen position"
myPen goto: 200 at 200.                                        "move to specified point"
myPen place: 250 at 250.                                       "move to specified point without drawing"
myPen print: ''Hello World'' withFont: (TextStyle default fontAt: 1).
Display extent.                                             "get display width at height"
Display width.                                              "get display width"
Display height.                                             "get display height"

].

Dynamic Message Calling/Compiling
Unary message
receiver := 5.
message := ''factorial'' asSymbol.
result := receiver perform: message.
result := Compiler evaluate: ((receiver storeString), '' '', message).
result := (Message new setSelector: message arguments: #()) sentTo: receiver.

Binary message
receiver := 1.
message := ''+'' asSymbol.
argument := 2.
result := receiver perform: message withArguments: (Array with: argument).
result := Compiler evaluate: ((receiver storeString), '' '', message, '' '', (argument storeString)).
result := (Message new setSelector: message arguments: (Array with: argument)) sentTo: receiver.

Keyword messages
receiver := 12.
keyword1 := ''between:'' asSymbol.
keyword2 := ''and:'' asSymbol.
argument1 := 10.
argument2 := 20.
result := receiver
   perform: (keyword1, keyword2) asSymbol
   withArguments: (Array with: argument1 with: argument2).
result := Compiler evaluate:
   ((receiver storeString), '' '', keyword1, (argument1 storeString) , '' '', keyword2, (argument2 storeString)).
result := (Message
   new
      setSelector: (keyword1, keyword2) asSymbol
      arguments: (Array with: argument1 with: argument2))
   sentTo: receiver.

Class/Metaclass
x := String name.                                           "class name"
x := String category.                                       "organization category"
x := String comment.                                        "class comment"
x := String kindOfSubclass.                                 "subclass type - subclass: variableSubclass, etc"
x := String definition.                                     "class definition"
x := String instVarNames.                                   "immediate instance variable names"
x := String allInstVarNames.                                "accumulated instance variable names"
x := String classVarNames.                                  "immediate class variable names"
x := String allClassVarNames.                               "accumulated class variable names"
x := String sharedPools.                                    "immediate dictionaries used as shared pools"
x := String allSharedPools.                                 "accumulated dictionaries used as shared pools"
x := String selectors.                                      "message selectors for class"
x := String sourceCodeAt: #size.                            "source code for specified method"
x := String allInstances.                                   "collection of all instances of class"
x := String superclass.                                     "immediate superclass"
x := String allSuperclasses.                                "accumulated superclasses"
x := String withAllSuperclasses.                            "receiver class and accumulated superclasses"
x := String subclasses.                                     "immediate subclasses"
x := String allSubclasses.                                  "accumulated subclasses"
x := String withAllSubclasses.                              "receiver class and accumulated subclasses"
b := String instSize.                                       "number of named instance variables"
b := String isFixed.                                        "true if no indexed instance variables"
b := String isVariable.                                     "true if has indexed instance variables"
b := String isPointers.                                     "true if index instance vars contain objects"
b := String isBits.                                         "true if index instance vars contain bytes/words"
b := String isBytes.                                        "true if index instance vars contain bytes"
b := String isWords.                                        true if index instance vars contain words"
Object withAllSubclasses size.                              "get total number of class entries"

Debuging
x yourself.                                                 "returns receiver"
String browse.                                              "browse specified class"
x inspect.                                                  "open object inspector window"
x confirm: ''Is this correct?''.
x halt.                                                     "breakpoint to open debugger window"
x halt: ''Halt message''.
x notify: ''Notify text''.
x error: ''Error string''.                                    "open up error window with title"
x doesNotUnderstand: #cmrMessage.                           "flag message is not handled"
x shouldNotImplement.                                       "flag message should not be implemented"
x subclassResponsibility.                                   "flag message as abstract"
x errorImproperStore.                                       "flag an improper store into indexable object"
x errorNonIntegerIndex.                                     "flag only integers should be used as index"
x errorSubscriptBounds.                                     "flag subscript out of bounds"
x primitiveFailed.                                          "system primitive failed"

a := ''A1''. b := ''B2''. a become: b.                          "switch two objects"
Transcript show: a, b; cr.

Miscellanea
"Smalltalk condenseChanges."                                "compress the change file"
x := FillInTheBlank request: ''Prompt Me''.                   "prompt user for input"
Utilities openCommandKeyHelp
!!
]style[(21 125 20 87 10 183 15 628 8 26 6 34 14 83 11 965 11 1183 10 1207 9 2726 23 4220 21 941 11 820 7 733 13 128 29 1133 23 1058 21 525 10 1175 7 1529 7 1934 7 5 28 9 42 9 2771 17 3384 16 3346 3 2333 5 3 43 11 2190 9 1883 13 49 11 4550 8 15 700 10 371 5 2561 5 1301 6 1634 10 21 4 1454 34 13 234 14 327 16 527 15 2669 8 1304 11 201)bu,,bi,,bu,,bi,,bi,,bi,,bu,,bu,,bu,,bu,,bu,,bu,,bu,,bu,,bu,,bu,,bi,,bu,,bu,,bu,,bu,,bu,,bu,bi,,bi,,bi,,bi,,bi,,bi,,bu,bi,,bi,,bu,,bu,,bu,,bu,bi,,bi,,bu,,bu,,bu,,bu,,bu,,bu,bi,,bi,,bi,,bi,,bi,,bi,!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>testRunnerMenuItemOn: (in category 'submenu - tools') -----
testRunnerMenuItemOn: menu
	Smalltalk at: #TestRunner ifPresent:[:aClass|
		menu addItem: [ :item |
			item
				contents: 'Test Runner' translated;
				help: 'Open the Test Runner' translated;
				icon: (self colorIcon: aClass basicNew defaultBackgroundColor);
				target: aClass;
				selector: #open ]
	].!

----- Method: TheWorldMainDockingBar>>toggleFullScreenMenuItemOn: (in category 'submenu - projects') -----
toggleFullScreenMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Toggle Full Screen' translated;
			help: 'Switch back and forth from full screen mode' translated;
			icon: MenuIcons smallFullScreenIcon;
			target: Project current;
			selector: #toggleFullScreen ]!

----- Method: TheWorldMainDockingBar>>toolsMenuOn: (in category 'construction') -----
toolsMenuOn: aDockingBar 

	aDockingBar addItem: [ :item |
		item
			contents: 'Tools' translated;
			addSubMenu: [ :menu | 
				self
					browserMenuItemOn: menu;
					workspaceMenuItemOn: menu;
					transcriptMenuItemOn: menu;
					testRunnerMenuItemOn: menu.
				menu addLine.
				self 
					monticelloBrowserMenuItemOn: menu;
					monticelloConfigurationsMenuItemOn: menu;
					simpleChangeSorterMenuItemOn: menu;
					dualChangeSorterMenuItemOn: menu.
				menu addLine.
				self
					processBrowserMenuItemOn: menu;
					preferenceBrowserMenuItemOn: menu;
					fileListMenuItemOn: menu.
			] ]!

----- Method: TheWorldMainDockingBar>>transcriptMenuItemOn: (in category 'submenu - tools') -----
transcriptMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Transcript' translated;
			help: 'Open the Transcript' translated;
			icon: (self colorIcon: Preferences transcriptWindowColor);
			target: Transcript;
			selector: #open ]!

----- Method: TheWorldMainDockingBar>>updateIfNeeded: (in category 'private') -----
updateIfNeeded: aDockingBar 
"Update the given docking bar if needed"
	| timeStamp |
	timeStamp := aDockingBar
				valueOfProperty: #mainDockingBarTimeStamp
				ifAbsent: [^ self].
	timeStamp = self class timeStamp
		ifTrue: [^ self].
	""
	aDockingBar removeAllMorphs.
	self fillDockingBar: aDockingBar!

----- Method: TheWorldMainDockingBar>>updateJumpToProjectSubMenu: (in category 'submenu - projects') -----
updateJumpToProjectSubMenu: subMenu

	subMenu defaultTarget: Project.
	Project current buildJumpToMenu: subMenu!

----- Method: TheWorldMainDockingBar>>updateMenuItemOn: (in category 'submenu - squeak') -----
updateMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Update Squeak' translated;
			help: 'Load latest code updates via the internet' translated;
			target: self;
			selector: #updateSqueak ]!

----- Method: TheWorldMainDockingBar>>updateNewProjectSubMenu: (in category 'submenu - projects') -----
updateNewProjectSubMenu: menu

	Project allSubclasses do: [ :each |
		menu addItem: [ :item | 
			item
				contents: ('New ', each name) translated;
				help: ('Start a new ', each name) translated;
				target: self;
				selector: #newProject:;
				arguments: { each } ] ]!

----- Method: TheWorldMainDockingBar>>updateSqueak (in category 'menu actions') -----
updateSqueak

	Utilities updateFromServer!

----- Method: TheWorldMainDockingBar>>vmStatistics (in category 'menu actions') -----
vmStatistics
	"Open a string view on a report of vm statistics"

	(StringHolder new contents: SmalltalkImage current  vmStatisticsReportString)
		openLabel: 'VM Statistics'!

----- Method: TheWorldMainDockingBar>>welcomeToSqueak41 (in category 'submenu - help') -----
welcomeToSqueak41
	^'Squeak 4.1
		Welcome to Squeak - a free, open Smalltalk system.

Squeak 4.1 combines the license change occuring in the 4.0 release with the development work that has been going on while the relicensing process took place. Here are the highlights of the changes that resulted in Squeak 4.1:

User Interface
We have adapted the ''face lift'' look originally developed for Newspeak. For those of us who like colored windows (quite a few as it turns out) you can switch between uniform and colored windows in the ''Extras'' menu under ''Window Colors''.

The new menu bar makes Squeak much easier to discover than before. The process of transitioning from the world menu is not complete yet, there are still items that can only be accessed from the world menu (i.e., by clicking on the desktop). 

The search field integrated in the menu bar allows for direct navigation to classes and methods - simply type in a partial class or method name and see what happens.

A new set of inexpensive sub-pixel antialiased fonts derived from the DejaVu fonts (''Bitmap DejaVu'' in the font chooser) has been added. True type font support has been upgraded to operate directly on files on disk without the need to load the entire file into memory.

A new set of text editors has been added, which allowed us to decouple the Morphic and MVC implementations for improved modularity. Morphic now has regular blinking insertion point cursors instead of the (virtually invisible) static cursor previously.

Compiler
Squeak 4.1 includes the closure implementation from Cog as a prerequisite for full Cog adoption later. With this implementation Squeak finally has ''full'' closures, allowing classic recursive examples like the following to work:

	fac := [:n| n > 1 ifTrue:[n * (fac value: n-1)] ifFalse:[1]].
	fac value: 5.

Support for literal ByteArray syntax has been added. Byte arrays can now be written as #[1 2 3] instead of #(1 2 3) asByteArray  avoiding the need for conversion.

Selectors including minus are now parsed correctly, for example 3 <- 4 is now parsed as (3) <- (4) instead of (3) < (-4). White space is no longer allowed after an unary minus to denote a negative number literal.

Development
Syntax highlighting, based on Shout, is now included in all Squeak tools by default. For workspaces, it can be explicitly disabled in the window menu (press the blue button; entry ''syntax highlighting'').

Sources and changes files are no longer limited to 32MB max size. ExpandedSourceFileArray provides an implementation for source files of arbitrary length, based on the CompiledMethodTrailer changes.

MessageTrace has been added, allowing senders and implementors to be viewed without opening new windows all the time.  It utilizes a new AlternatePluggableListMorphOfMany, which allows quick and easy customization of the list. A quick adoption of DependencyBrowser has been added allowing to browse dependencies between packages.

Core Libraries
Sets can now store nil just as any other collection. The collection hierachy has been refactored to have both Set and Dictionary a subclass of HashedCollection instead of having Dictionary a subclass of Set. Squeak now uses a better distributed scaledIdentityHash for identity sets and dictionaries.

StandardFilestream now performs read-buffering, dramatically speading up some operations like "Object compileAll" (2x improvement) as well as various other operations (scanning change lists etc).

A new traits implementation has been added. The implementation is significantly smaller and simpler than the old version and can be unloaded and reloaded without loss of information (i.e., traits flattened during unload are restored during traits reloading).

A new extensible number parser hierharchy has been introduced NumberParser and its subclasses provide support for parsing and building numbers from strings and streams.

A new general cleanup protocol has been added. The cleanUp protocol takes an optional argument to indicate whether we''re doing an aggressive cleanup (which involves deleting projects, change sets, and possibly other destructive actions) or a more gentle cleanup that''s only supposed to clean out transient caches.

SystemDictionary and SmalltalkImage have been refactored. Smalltalk is now an instance of SmalltalkImage, representing a facade for system-wide queries and actions. SmalltalkImage contains a global environment, an instance of SystemDictionary, which the environment used by classes. Thus, SmalltalkImage current == Smalltalk, Object environment == Smalltalk globals.

Modularity
The following packages have been made reloadable: ReleaseBuilder, ScriptLoader, 311Deprecated, 39Deprecated, Universes, SMLoader, SMBase, Installer-Core, VersionNumberTests, VersionNumber, Services-Base, PreferenceBrowser, Nebraska, CollectionsTests, GraphicsTests, KernelTests, MorphicTests, MultilingualTests, NetworkTests, ToolsTests, TraitsTests, XML-Parser, Traits, SystemChangeNotification-Tests, FlexibleVocabularies, EToys, Protocols, Tests, SUnitGUI. To unload all of these, execute:

	Smalltalk unloadAllKnownPackages.
!!
]style[(11 53 228 14 920 251 2 8 309 376 2 11 206 529 2 14 302 197 1113 10 1 50 479)a2cblue;bFBitmap DejaVu Sans#14,c006006006bFBitmap DejaVu Sans#14,FBitmap DejaVu Sans#14,FBitmap DejaVu Sans#14bu,FBitmap DejaVu Sans#14,,FBitmap DejaVu Sans#14,FBitmap DejaVu Sans#14bu,FBitmap DejaVu Sans#14,,FBitmap DejaVu Sans#14,FBitmap DejaVu Sans#14bu,FBitmap DejaVu Sans#14,,FBitmap DejaVu Sans#14,FBitmap DejaVu Sans#14bu,FBitmap DejaVu Sans#14,f1,,bu,,FBitmap DejaVu Sans#14,!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>welcomeWorkspacesOn: (in category 'submenu - help') -----
welcomeWorkspacesOn: menu

	menu addItem:[:item|
		item
			contents: 'Welcome to Squeak 4.1' translated;
			help: 'A Welcome Workspace' translated;
			target: self;
			selector: #showWelcomeText:label:in:;
			arguments: {
				#welcomeToSqueak41. 
				'Welcome to Squeak 4.1'. 
				(140 at 140 extent: 500 at 300)
			}].
	menu addItem:[:item|
		item
			contents: 'The Squeak User Interface' translated;
			help: 'A Welcome Workspace' translated;
			target: self;
			selector: #showWelcomeText:label:in:;
			arguments: {
				#squeakUserInterface. 
				'The Squeak User Interface'. 
				(160 at 160 extent: 500 at 300)
			}].
	menu addItem:[:item|
		item
			contents: 'Working With Squeak' translated;
			help: 'A Welcome Workspace' translated;
			target: self;
			selector: #showWelcomeText:label:in:;
			arguments: {
				#workingWithSqueak. 
				'Working With Squeak'. 
				(180 at 180 extent: 500 at 300)
			}].
	menu addItem:[:item|
		item
			contents: 'Terse Guide to Squeak' translated;
			help: 'A Welcome Workspace' translated;
			target: self;
			selector: #showWelcomeText:label:in:;
			arguments: {
				#terseGuideToSqueak. 
				'Terse Guide to Squeak'. 
				(180 at 180 extent: 600 at 400)
			}].
	menu addItem:[:item|
		item
			contents: 'License Information' translated;
			help: 'A Welcome Workspace' translated;
			target: self;
			selector: #showWelcomeText:label:in:;
			arguments: {
				#licenseInformation. 
				'License Information'. 
				(200 at 200 extent: 500 at 300)
			}].!

----- Method: TheWorldMainDockingBar>>windowColorsOn: (in category 'construction') -----
windowColorsOn: menu

	menu addItem:[:item|
		item
			contents: 'Uniform Windows' translated;
			help: 'Use uniform window colors' translated;
			target: Preferences;
			selector: #installUniformWindowColors].

	menu addItem:[:item|
		item
			contents: 'Colorful Windows' translated;
			help: 'Use bright window colors' translated;
			target: Preferences;
			selector: #installBrightWindowColors].
!

----- Method: TheWorldMainDockingBar>>windowMenuFor:on: (in category 'submenu - windows') -----
windowMenuFor: window on: menu

	menu 
		addItem: [ :item |
			item
				contents: 'Close';
				target: window;
				selector: #delete ];
		addItem: [ :item |
			item
				contents: 'Close all like this';
				target: self;
				selector: #closeAllWindowsLike:;
				arguments: { window } ];
		addItem: [ :item |
			item
				contents: 'Close all but this';
				target: self;
				selector: #closeAllWindowsBut:;
				arguments: { window } ];
		addItem: [ :item |
			item 
				contents: 'Toggle Full Screen';
				target: window;
				selector: #expandBoxHit ]!

----- Method: TheWorldMainDockingBar>>windowMenuItemLabelFor: (in category 'submenu - windows') -----
windowMenuItemLabelFor: window
	| s |
	s := WriteStream on: String new.
	window model canDiscardEdits ifFalse: [ s nextPut: $* ].
	window isCollapsed ifTrue: [ s nextPut: $( ].
	s nextPutAll: window label.
	window isCollapsed ifTrue: [ s nextPut: $) ].
	^s contents contractTo: 50!

----- Method: TheWorldMainDockingBar>>windowsMenuOn: (in category 'construction') -----
windowsMenuOn: aDockingBar

	aDockingBar addItem: [ :item |
		item
			contents: 'Windows' translated;
			subMenuUpdater: self
			selector: #listWindowsOn: ]
!

----- Method: TheWorldMainDockingBar>>workingWithSqueak (in category 'submenu - help') -----
workingWithSqueak
	^'Starting and Quitting
Obviously you have figured out how to start the system.  One way is to double-click on an image.  If you have several different interpreters, you may want to drag the image to the appropriate interpreter; that lets you decide which interpreter should be used.

To quit a Squeak session, choose ''quit'' from the menu bar.  If you save, your previous image file will be overwritten.  You may choose ''save as...'' or ''save as new version'' to save a copy of your image and changes files with a new name (see below).

Image File
All of the objects -- classes, dictionaries, windows and other objects -- that make up the Squeak environment are stored in an image file (this must be named ''SomeName.image'' or ''SomeName.ima'').  When you start up an image, everything is right where you left it when you last saved that image.

Sources and Changes
The source code associated with the Squeak code in an image file is stored in two other files.  The code of the base system (e.g., Squeak version 4.1) is stored in the file ''SqueakV41.sources'', and the sources for methods added or changed since that time are in the changes file (which must similarly be named ''SomeName.changes'').

Storing the source code in a separate file has several advantages.  To begin with, if you have been working for a couple of hours, and your dog pulls out the power cord, you will still have a sequential record of all your program edits, and these can be perused and replayed to recover your work.  This feature has also saved many a hacker who got too adventurous while changing the system he or she was using.

However, if you wish to run the system with severely limited resources, it can be operated without any source code, owing to its ability to decompile the bytecode methods into a readable and editable version of the original source code (only comments and temporary variable names are lost).

Finally, since the changes file does not consume memory space, Squeak keeps a complete history of all your program changes.  This makes it easy to examine or even reinstate older versions of methods (see ''versions'' option in browser selector pane).  This encourages experimentation, since you can easily revert to the original versions of any set of methods.

FileOut, FileIn
In addition to the ''save'' command that saves the entire state of your Squeak image, individual methods, categories and classes may be ''filed out''.  Filing out a method, category, or class results in the creation of a text file containing the code in question.  This file can be read into the same or another Squeak image to recreate the saved classes and methods.

ChangeLists, ChangeSets, and ChangeSorters
A ChangeList is a method-by-method view of a fileOut.  Note that the changes file records all your programming actions using the same fileOut format, so a ChangeList can browse the change history of any Squeak image.  The "recover changes" command of the Extras menu is one way to do this. You can also open a ChangeList on any fileOut file by selecting the file in the FileList and selecting the "browse changes" command.

In addition to the image-wide record of changes kept in the changes file, a record of changes is also associated with every project.  This "change set" records only the class and method changes you made within that project. This allows you to make a fileOut of all the changes that constitute your work on that project.  Single and dual ChangeSorters allow one to examine the change set of the current project and other projects, and also allows changes to be moved between change sets.  These are very useful tools for more experienced Squeak programmers.

Organizing your Disk
Squeak will look for the sources file either in the folder containing the image.  If the sources file is not found there, then it looks in the folder containing the VM.  In general, it is simplest to keep a single copy of the sources file in the folder containing the VM.  You can use any number of image/changes pairs anywhere on your disk.

If you wish to maintain several versions of the VM, here is the easiest way:  place all VMs in one folder along with the sources file.  Then, in each folder with images for version X, place an alias of the VM for version X.  You can then start VM version X on that image by dragging the image onto the VM alias.  (If you start Squeak by double-clicking on the image, it might use the wrong version of the VM to run that image.)  Another technique is to keep an alias for your favorite VM on the desktop and start images by dropping them on this alias.  These instructions apply to Mac and Windows, but the same general strategy can be applied to Linux, Unix, and many other platforms.
!!
]style[(21 512 10 296 19 1397 15 366 42 983 20 1029)bu,,bu,,bu,,bu,,bu,,bu,!!' readStream nextChunkText!

----- Method: TheWorldMainDockingBar>>workspaceMenuItemOn: (in category 'submenu - tools') -----
workspaceMenuItemOn: menu

	menu addItem: [ :item |
		item
			contents: 'Workspace' translated;
			help: 'Open a Workspace' translated;
			icon: (self colorIcon: Preferences workspaceWindowColor);
			target: StandardToolSet;
			selector: #openWorkspace ]!

Object subclass: #TheWorldMenu
	instanceVariableNames: 'myProject myWorld myHand'
	classVariableNames: 'OpenMenuRegistry'
	poolDictionaries: ''
	category: 'Morphic-Kernel'!

!TheWorldMenu commentStamp: 'sw 10/5/2002 00:44' prior: 0!
Instances of TheWorldMenu serve to present the primary Squeak menu obtained by clicking on open desktop, which is variously spoken of as the "screen menu", the "desktop menu", or the "world menu".

myProject is the Project I pertain to.
myWorld is the world, a PasteUpMorph, that I pertain to.
myHand is the hand that invoked the menu.!

----- Method: TheWorldMenu class>>cleanUp (in category 'class initialization') -----
cleanUp
	"Flush out obsolete entries"

	self removeObsolete!

----- Method: TheWorldMenu class>>loadSqueakMap (in category 'open-menu registry') -----
loadSqueakMap
	"Load the externally-maintained SqueakMap package if it is not already loaded.  Based on code by Göran Hultgren"

	| server |
	Socket initializeNetwork.
	server := #('map1.squeakfoundation.org' 'map2.squeakfoundation.org' 'map.squeak.org' 'map.bluefish.se' 'marvin.bluefish.se:8000')
		detect: [:srv | | addr answer |
			addr := NetNameResolver addressForName: (srv upTo: $:) timeout: 5.
			addr notNil and: [
				answer := HTTPSocket httpGet: ('http://', srv, '/sm/ping').
				answer isString not and: [answer contents = 'pong']]]
		ifNone: [^ self inform: 'Sorry, no SqueakMap master server responding.'].
	server ifNotNil: ["Ok, found an SqueakMap server"
		ChangeSet newChangesFromStream:
			((('http://', server, '/sm/packagebyname/squeakmap/downloadurl')
			asUrl retrieveContents content) asUrl retrieveContents content unzipped
			readStream)
		named: 'SqueakMap']!

----- Method: TheWorldMenu class>>openPackageLoader (in category 'open-menu registry') -----
openPackageLoader
	"If this method is reached, it means that SMLoader has not yet been loaded; after SqueakMap has come into the image, a different receiver/selector will have been installed under 'Package Loader'; if this method is reached when theoretically SqueakMap is already loaded, presumably this is a grandfathered menu item in a still-up menu, so get the message on to its appropriate recipient."

	| loaderClass |
	((loaderClass := Smalltalk at: #SMLoader ifAbsent: [nil]) isKindOf: Class)
		ifTrue:
			[^ loaderClass open].

	(self confirm: 
'This requires that you first install "SqueakMap" into your image.
SqueakMap is a new architecture for finding, installing, and
publishing packages in Squeak.
Would you like to install SqueakMap now?' )
		ifTrue:
			[self loadSqueakMap]!

----- Method: TheWorldMenu class>>registerOpenCommand: (in category 'open-menu registry') -----
registerOpenCommand: anArray
	"The array received should be of form {'A Label String'. {TargetObject. #command}  'A Help String'} ; the final element is optional but if present will be used to supply balloon help for the menu item in the Open menu.
	If any previous registration of the same label string is already known, delete the old one."

	self unregisterOpenCommand: anArray first.
	OpenMenuRegistry addLast: anArray!

----- Method: TheWorldMenu class>>registeredOpenCommands (in category 'open-menu registry') -----
registeredOpenCommands
	"Answer the list of dynamic open commands, sorted by description"
	
	^self registry asArray sort: [ :a :b | a first asLowercase < b first asLowercase ]!

----- Method: TheWorldMenu class>>registry (in category 'open-menu registry') -----
registry
	"Answer the registry of dynamic open commands"
	
	^OpenMenuRegistry ifNil: [OpenMenuRegistry := OrderedCollection new].
!

----- Method: TheWorldMenu class>>removeObsolete (in category 'open-menu registry') -----
removeObsolete
	"Remove all obsolete commands"	
	self registry removeAllSuchThat: [:e | e second first class isObsolete].!

----- Method: TheWorldMenu class>>unregisterOpenCommand: (in category 'open-menu registry') -----
unregisterOpenCommand: label
	"Remove the open command with the given label from the registry"
	
	self registry removeAllSuchThat: [:e | e first = label]!

----- Method: TheWorldMenu class>>unregisterOpenCommandWithReceiver: (in category 'open-menu registry') -----
unregisterOpenCommandWithReceiver: aReceiver
	"Remove the open command with the given object as receiver from the registry"
	
	self registry removeAllSuchThat: [:e | e second first == aReceiver]!

----- Method: TheWorldMenu>>addGestureHelpItemsTo: (in category 'menu') -----
addGestureHelpItemsTo: aMenuMorph 
!

----- Method: TheWorldMenu>>addObjectsAndTools: (in category 'construction') -----
addObjectsAndTools: menu
	self
		fillIn: menu
		from: {
			nil.
			{ 'objects (o)'. { #myWorld. #activateObjectsTool }. 'A tool for finding and obtaining many kinds of objects' }.
			{ 'new morph...'. { self. #newMorph }. 'Offers a variety of ways to create new objects' }.
			nil.
			{ 'authoring tools...'. { self. #scriptingDo }. 'A menu of choices useful for authoring' }.
			{ 'playfield options...'. { self. #playfieldDo }. 'A menu of options pertaining to this object as viewed as a playfield' }.
			{ 'flaps...'. { self. #flapsDo }. 'A menu relating to use of flaps.  For best results, use "keep this menu up"' }.
			{ 'projects...'. { self. #projectDo }. 'A menu of commands relating to use of projects' }.
			{ 'telemorphic...' . {self. #remoteDo}.  'commands for doing multi-machine "telemorphic" experiments'}.
			nil
		}!

----- Method: TheWorldMenu>>addPrintAndDebug: (in category 'construction') -----
addPrintAndDebug: menu
	Preferences simpleMenus ifFalse: [
		self
			fillIn: menu
			from: {
				{ 'make screenshot'. {self. #saveScreenshot}. 'makes a screenshot and saves it to disk'}.
				"{ 'print PS to file...'. { self. #printWorldOnFile }. 'write the world into a postscript file' }."
				{ 'debug...'. { self. #debugDo }. 'a menu of debugging items' }
			} ]!

----- Method: TheWorldMenu>>addProjectEntries: (in category 'construction') -----
addProjectEntries: menu
	self
		fillIn: menu
		from: {
			nil.
			{ 'previous project'. { #myWorld. #goBack }. 'return to the most-recently-visited project' }.
			{ 'jump to project...'. { #myWorld. #jumpToProject }. 'put up a list of all projects, letting me choose one to go to' }.
			{ 'save project on file...'. { #myWorld. #saveOnFile }. 'save this project on a file' }.
			{'load project from file...'. {self. #loadProject}. 'load a project from a file' }.
			nil
		}!

----- Method: TheWorldMenu>>addRestoreDisplay: (in category 'construction') -----
addRestoreDisplay: menu
	self
		fillIn: menu
		from: {
			{'restore display (r)'. { World. #restoreMorphicDisplay }. 'repaint the screen -- useful for removing unwanted display artifacts, lingering cursors, etc.' }.
			nil
		}!

----- Method: TheWorldMenu>>addSaveAndQuit: (in category 'construction') -----
addSaveAndQuit: menu
	self
		fillIn: menu
		from: {
			nil.
			{ 'save'. { SmalltalkImage current. #saveSession }. 'save the current version of the image on disk' }.
			{ 'save as...'. { SmalltalkImage current. #saveAs }. 'save the current version of the image on disk under a new name.' }.
			{ 'save as new version'. { SmalltalkImage current. #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.' }
		}!

----- Method: TheWorldMenu>>addUtilities: (in category 'construction') -----
addUtilities: menu
	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.' }
			} ]!

----- Method: TheWorldMenu>>alphabeticalMorphMenu (in category 'construction') -----
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!

----- Method: TheWorldMenu>>appearanceDo (in category 'popups') -----
appearanceDo
	"Build and show the appearance menu for the world."

	self doPopUp: self appearanceMenu!

----- Method: TheWorldMenu>>appearanceMenu (in category 'construction') -----
appearanceMenu
	"Build the appearance menu for the world."

	^self fillIn: (self menu: 'appearance...') from: {

		{'preferences...' . { self . #openPreferencesBrowser} . 'Opens a "Preferences Browser" which allows you to alter many settings' } .
		{'choose theme...' . { Preferences . #offerThemesMenu} . 'Presents you with a menu of themes; each item''s balloon-help will tell you about the theme.  If you choose a theme, many different preferences that come along with that theme are set at the same time; you can subsequently change any settings by using a Preferences Panel'} .
		nil .
		{'system fonts...' . { self . #standardFontDo} . 'Choose the standard fonts to use for code, lists, menus, window titles, etc.'}.
		{'text highlight color...' . { Preferences . #chooseTextHighlightColor} . 'Choose which color should be used for text highlighting in Morphic.'}.
		{'insertion point color...' . { Preferences . #chooseInsertionPointColor} . 'Choose which color to use for the text insertion point in Morphic.'}.
		{'keyboard focus color' . { Preferences . #chooseKeyboardFocusColor} . 'Choose which color to use for highlighting which pane has the keyboard focus'}.
		nil.
		{#menuColorString . { Preferences . #toggleMenuColorPolicy} . 'Governs whether menu colors should be derived from the desktop color.'}.
		{#roundedCornersString . { Preferences . #toggleRoundedCorners} . 'Governs whether morphic windows and menus should have rounded corners.'}.
		nil.
		{'full screen on' . { Project current . #fullScreenOn} . 'puts you in full-screen mode, if not already there.'}.
		{'full screen off' . { Project current . #fullScreenOff} . 'if in full-screen mode, takes you out of it.'}.
		nil.
		{'set display depth...' . {self. #setDisplayDepth} . 'choose how many bits per pixel.'}.
		{'set desktop color...' . {self. #changeBackgroundColor} . 'choose a uniform color to use as desktop background.'}.
		{'set gradient color...' . {self. #setGradientColor} . 'choose second color to use as gradient for desktop background.'}.
		{'use texture background' . { #myWorld . #setStandardTexture} . 'apply a graph-paper-like texture background to the desktop.'}.
		nil.
		{'clear turtle trails from desktop' . { #myWorld . #clearTurtleTrails} . 'remove any pigment laid down on the desktop by objects moving with their pens down.'}.
		{'pen-trail arrowhead size...' . { Preferences. #setArrowheads} . 'choose the shape to be used in arrowheads on pen trails.'}.

	}!

----- Method: TheWorldMenu>>buildWorldMenu (in category 'construction') -----
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 makeConvenient: menu.
	Smalltalk at: #ServiceGUI ifPresent:[:sgui|
		sgui worldMenu: menu.
		sgui onlyServices ifTrue: [^ menu].
	].
	self addProjectEntries: menu.
	myWorld addUndoItemsTo: menu.
	self addRestoreDisplay: menu.
	self addUtilities: menu.
	self addObjectsAndTools: menu.
	self addPrintAndDebug: menu.
	self addSaveAndQuit: menu.
	^ menu!

----- Method: TheWorldMenu>>changeBackgroundColor (in category 'commands') -----
changeBackgroundColor
	"Let the user select a new background color for the world"

	myWorld changeColorTarget: myWorld selector: #color: originalColor: myWorld color hand: myWorld activeHand.
!

----- Method: TheWorldMenu>>changesDo (in category 'popups') -----
changesDo
	"Build the changes menu for the world."

	self doPopUp: self changesMenu!

----- Method: TheWorldMenu>>changesMenu (in category 'construction') -----
changesMenu
        "Build the changes menu for the world."

        | menu |
        menu := self menu: 'changes...'.
        self fillIn: menu from: {
                { 'file out current change set' . { ChangeSet current . #verboseFileOut}.
                                'Write the current change set out to a file whose name reflects the change set name and the current date & time.'}.
                { 'create new change set...' . { ChangeSet . #newChangeSet}. 'Create a new change set and make it the current one.'}.
                { 'browse changed methods' . { ChangeSet  . #browseChangedMessages}.  'Open a message-list browser showing all methods in the current change set'}.
                { 'check change set for slips' . { self  . #lookForSlips}.
                                'Check the current change set for halts, references to the Transcript, etc., and if any such thing is found, open up a message-list browser detailing all possible slips.'}.

                nil.
                { 'simple change sorter' . {self. #openChangeSorter1}.  'Open a 3-paned changed-set viewing tool'}.
                { 'dual change sorter' . {self. #openChangeSorter2}.
                                'Open a change sorter that shows you two change sets at a time, making it easy to copy and move methods and classes between them.'}.
               { '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'}.
                nil.
                { 'browse recent submissions (R)' . { Utilities . #browseRecentSubmissions}.
                                'Open a new recent-submissions browser.  A recent-submissions browser is a message-list browser that shows the most recent methods that have been submitted.  If you submit changes within that browser, it will keep up-to-date, always showing the most recent submissions.'}.

			nil.
                { 'recently logged changes...' . { self . #browseRecentLog}.'Open a change-list browser on the latter part of the changes log.  You can use this browser to recover logged changes which were not saved in your image, in the event of a crash or other interruption.'}.

                { 'recent log file...' . { Smalltalk . #writeRecentToFile}.
                                'Create a file holding the logged changes (going as far back as you wish), and open a window on that file.'}.

                nil.
                { 'save world as morph file' . {self. #saveWorldInFile}. 'Save a file that, when reloaded, reconstitutes the current World.'}.
                nil.
        }.
        ^ menu!

----- Method: TheWorldMenu>>cleanUpWorld (in category 'commands') -----
cleanUpWorld
	(UIManager default 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]!

----- Method: TheWorldMenu>>colorForDebugging: (in category 'construction') -----
colorForDebugging: aMenu

        "aMenu color: self myMenuColor"

        "aMenu color: Color lightRed"

!

----- Method: TheWorldMenu>>commandKeyTypedIntoMenu: (in category 'action') -----
commandKeyTypedIntoMenu: evt
	"The user typed a command-key into the given menu; dispatch it"

	myWorld keystrokeInWorld: evt !

----- Method: TheWorldMenu>>debugDo (in category 'popups') -----
debugDo

	self doPopUp: self debugMenu!

----- Method: TheWorldMenu>>debugMenu (in category 'construction') -----
debugMenu

        | menu |

        menu := self menu: 'debug...'.
        self fillIn: menu from: { 
                { 'inspect world' . { #myWorld . #inspect } }.
                { 'explore world' . { #myWorld . #explore } }.
                { 'inspect model' . { self . #inspectWorldModel } }.
                        " { 'talk to world...' . { self . #typeInMessageToWorld } }."
                { 'start MessageTally' . { self . #startMessageTally } }.
                { 'start/browse MessageTally' . { self . #startThenBrowseMessageTally } }.
                { 'open process browser' . { self . #openProcessBrowser } }.
                nil.
                        "(self hasProperty: #errorOnDraw) ifTrue:  Later make this come up only when needed."
                { 'start drawing again' . { #myWorld . #resumeAfterDrawError } }.
                { 'start stepping again' . { #myWorld . #resumeAfterStepError } }.
                nil.
                { 'call #tempCommand' . { #myWorld . #tempCommand } }.
                { 'define #tempCommand' . { #myWorld . #defineTempCommand } }.
        }.
	self haltOnceEnabled
		ifTrue: [menu
				add: 'disable halt/inspect once' translated
				target: menu
				action: #clearHaltOnce]
		ifFalse: [menu
				add: 'enable halt/inspect once' translated
				target: menu
				action: #setHaltOnce].
	^menu
	!

----- Method: TheWorldMenu>>doMenuItem:with: (in category 'action') -----
doMenuItem: aCollection with: event
	| realTarget selector nArgs |
	selector := aCollection second.
	nArgs := selector numArgs.
	realTarget := aCollection first.
	realTarget == #myWorld ifTrue: [realTarget := myWorld].
	realTarget == #myHand ifTrue: [realTarget := myHand].
	realTarget == #myProject ifTrue: [realTarget := self projectForMyWorld].
	^nArgs = 0 
		ifTrue:[realTarget perform: selector]
		ifFalse:[realTarget perform: selector with: event].
!

----- Method: TheWorldMenu>>doPopUp: (in category 'popups') -----
doPopUp: aMenu

	aMenu popUpForHand: myHand in: myWorld.
!

----- Method: TheWorldMenu>>fillIn:from: (in category 'construction') -----
fillIn: aMenu from: dataForMenu
	"A menu constructor utility by RAA.  dataForMenu is a list of items which mean:
			nil							Indicates to add a line

			first element is symbol		Add updating item with the symbol as the wording selector
			second element is a list		second element has the receiver and selector

			first element is a string		Add menu item with the string as its wording
			second element is a list		second element has the receiver and selector

			a third element exists		Use it as the balloon text
			a fourth element exists		Use it as the enablement selector (updating case only)"
	

	dataForMenu do: [ :itemData | | item |
		itemData ifNil: [aMenu addLine] ifNotNil:
			[item := (itemData first isKindOf: Symbol)
				ifTrue: 
					[aMenu 
						addUpdating: itemData first 
						target: self 
						selector: #doMenuItem:with: 
						argumentList: {itemData second}]
				 ifFalse:
					[aMenu 
						add: itemData first translated
						target: self 
						selector: #doMenuItem:with: 
						argumentList: {itemData second}].
			itemData size >= 3 ifTrue:
				[aMenu balloonTextForLastItem: itemData third translated.
			itemData size >= 4 ifTrue:
				[item enablementSelector: itemData fourth]]]].

	^ aMenu!

----- Method: TheWorldMenu>>garbageCollect (in category 'commands') -----
garbageCollect
	"Do a garbage collection, and report results to the user."

	Utilities garbageCollectAndReport!

----- Method: TheWorldMenu>>helpDo (in category 'popups') -----
helpDo
	"Build and show the help menu for the world."

	self doPopUp: self helpMenu!

----- Method: TheWorldMenu>>helpMenu (in category 'construction') -----
helpMenu
        "Build the help menu for the world."
        |  menu |

  	menu := self menu: 'help...'.

        self fillIn: menu from:
        {
                {'about this system...'. {SmalltalkImage current. #aboutThisSystem}. 'current version information.'}.
                {'update code from server'. {Utilities. #updateFromServer}. 'load latest code updates via the internet'}.
                {'preferences...'. {self. #openPreferencesBrowser}. 'view and change various options.'}.
			 {'set language...' . {Project. #chooseNaturalLanguage}. 'choose the language in which tiles should be displayed.'} .
                nil.
               {'command-key help'. { Utilities . #openCommandKeyHelp}. 'summary of keyboard shortcuts.'}
	}.

	self addGestureHelpItemsTo: menu.

	self fillIn: menu from:
	{
                {'world menu help'. { self . #worldMenuHelp}. 'helps find menu items buried in submenus.'}.
                        "{'info about flaps' . { Utilities . #explainFlaps}. 'describes how to enable and use flaps.'}."
                {'font size summary' . { TextStyle . #fontSizeSummary}.  'summary of names and sizes of available fonts.'}.
                {'useful expressions' . { Utilities . #openStandardWorkspace}. 'a window full of useful expressions.'}.
			 {'annotation setup...' . { Preferences . #editAnnotations}. 'Click here to get a little window that will allow you to specify which types of annotations, in which order, you wish to see in the annotation panes of browsers and other tools'}.
			nil.
                {'graphical imports' . { Imports default . #viewImages}.  'view the global repository called ImageImports; you can easily import external graphics into ImageImports via the FileList'}.
                {'standard graphics library' . { ScriptingSystem . #inspectFormDictionary}.  'lets you view and change the system''s standard library of graphics.'}.
                nil.
                {'telemorphic...' . {self. #remoteDo}.  'commands for doing multi-machine "telemorphic" experiments'}.
                {#soundEnablingString . { Preferences . #toggleSoundEnabling}. 'turning sound off will completely disable Squeak''s use of sound.'}.
                nil.

                {'set author initials...' . { Utilities . #setAuthorInitials }. 'supply initials to be used to identify the author of code and other content.'}.
                {'vm statistics' . { self . #vmStatistics}.  'obtain some intriguing data about the vm.'}.
			  nil.
			  {'purge undo records' . { CommandHistory . #resetAllHistory }. 'save space by removing all the undo information remembered in all projects.'}.
                {'space left' . { self . #garbageCollect}. 'perform a full garbage-collection and report how many bytes of space remain in the image.'}.
        }.

	^menu

!

----- Method: TheWorldMenu>>loadProject (in category 'commands') -----
loadProject

	| stdFileMenuResult path |
	"Put up a Menu and let the user choose a '.project' file to load.  Create a thumbnail and jump into the project."

	Project canWeLoadAProjectNow ifFalse: [^ self].
	path := FileList2 modalFolderSelector.
	path ifNil: [^ nil].
	stdFileMenuResult := ((StandardFileMenu new) pattern: '*.pr'; 
		oldFileFrom: path) 
			startUpWithCaption: 'Select a File:' translated.
	stdFileMenuResult ifNil: [^ nil].
	ProjectLoading 
		openFromDirectory: stdFileMenuResult directory 
		andFileName: stdFileMenuResult name
!

----- Method: TheWorldMenu>>lookForSlips (in category 'commands') -----
lookForSlips

	ChangeSet current lookForSlips!

----- Method: TheWorldMenu>>makeConvenient: (in category 'construction') -----
makeConvenient: menu
	self
		fillIn: menu
		from: {
			{ 'Browser'. { StandardToolSet. #openClassBrowser }. 'open a browser' }.
			{ 'Workspace'. { Workspace. #open }. 'open a workspace' }.
			{ 'Transcript'. { Transcript. #open }. 'open a transcript' }.
			Smalltalk at: #TestRunner ifPresent:[:aClass|
				{ 'Test Runner'. { aClass. #open }. 'open a test runner' }.
			].
			nil
		}!

----- Method: TheWorldMenu>>menu: (in category 'mechanics') -----
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
!

----- Method: TheWorldMenu>>menuColorString (in category 'action') -----
menuColorString

	^ Preferences menuColorString!

----- Method: TheWorldMenu>>mvcProjectsAllowed (in category 'commands') -----
mvcProjectsAllowed

	^Preferences mvcProjectsAllowed and: [Smalltalk includesKey: #StandardSystemView]!

----- Method: TheWorldMenu>>newMorph (in category 'construction') -----
newMorph
	"The user requested 'new morph' from the world menu.  Put up a menu that allows many ways of obtaining new morphs."

	| menu |

	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;
		add: 'from a file...' translated target: self action: #readMorphFromAFile.
	menu addLine.
	menu add: 'grab rectangle from screen' translated target: myWorld action: #grabDrawingFromScreen:;
		add: 'grab with lasso from screen' translated target: myWorld action: #grabLassoFromScreen:;
		add: 'grab rubber band from screen' translated target: myWorld action: #grabRubberBandFromScreen:;
		add: 'grab flood area from screen' translated target: myWorld action: #grabFloodFromScreen:.
	menu addLine.
	menu add: 'make new drawing' translated target: myWorld action: #newDrawingFromMenu:;
		add: 'make link to project...' translated target: self action: #projectThumbnail.

	self doPopUp: menu.
!

----- Method: TheWorldMenu>>newMorphOfClass:event: (in category 'commands') -----
newMorphOfClass: morphClass event: evt
	"Attach a new morph of the given class to the invoking hand."

	| m |
	m := morphClass new.
	m installModelIn: myWorld.  "a chance to install model pointers"
	m wantsToBeOpenedInWorld
		ifTrue:[myWorld addMorph: m]
		ifFalse:[evt hand attachMorph: m].
	myWorld startSteppingSubmorphsOf: m.
!

----- Method: TheWorldMenu>>openBrowser (in category 'commands') -----
openBrowser 
	"Create and schedule a Browser view for browsing code."
	ToolSet browse: nil selector: nil!

----- Method: TheWorldMenu>>openFileDirectly (in category 'commands') -----
openFileDirectly

	FileList openFileDirectly!

----- Method: TheWorldMenu>>openFileList (in category 'commands') -----
openFileList
	FileList open.!

----- Method: TheWorldMenu>>openMVCProject (in category 'commands') -----
openMVCProject
	"Open a new MVC project (only if MVC is present)"
	Smalltalk at: #MVCProject ifPresent:[:projClass|
		ProjectViewMorph openOn: projClass new.
	].!

----- Method: TheWorldMenu>>openMenu (in category 'construction') -----
openMenu
	"Build the open window menu for the world."

	| menu |
	menu := self menu: 'open...'.
	menu defaultTarget: ToolSet default.
	menu addList: ToolSet menuItems.
	menu defaultTarget: self.
	self fillIn: menu from: {
		nil.
		{'file...' . { self . #openFileDirectly} . 'Lets you open a window on a single file'}.
		{'transcript (t)' . {self . #openTranscript}. 'A window used to report messages sent to Transcript' }.
		"{'inner world' . { WorldWindow . #test1} }."
		nil.
	}.
	self fillIn: menu from: self class registeredOpenCommands.
	menu addLine.

	self mvcProjectsAllowed ifTrue:
		[self fillIn: menu from: { {'mvc project' . {self. #openMVCProject} . 'Creates a new project of the classic "mvc" style'} }].

	^ self fillIn: menu from: { 
		{'morphic project' . {self. #openMorphicProject} . 'Creates a new morphic project'}.
	}.!

----- Method: TheWorldMenu>>openMorphicProject (in category 'commands') -----
openMorphicProject
	"Open a morphic project from within a morphic project"
	MorphicProject openViewOn: nil
!

----- Method: TheWorldMenu>>openPreferencesBrowser (in category 'commands') -----
openPreferencesBrowser
	"Open a preferences browser"
	^Smalltalk at: #PreferenceBrowser ifPresent:[:pb| pb open].
!

----- Method: TheWorldMenu>>openTranscript (in category 'commands') -----
openTranscript

	Transcript openLabel: 'Transcript'!

----- Method: TheWorldMenu>>openWindow (in category 'popups') -----
openWindow

	self doPopUp: self openMenu!

----- Method: TheWorldMenu>>openWorkspace (in category 'commands') -----
openWorkspace

	UIManager default edit: '' label: 'Workspace'!

----- Method: TheWorldMenu>>projectDo (in category 'popups') -----
projectDo
	"Build and show the project menu for the world."

	self doPopUp: self projectMenu!

----- Method: TheWorldMenu>>projectForMyWorld (in category 'commands') -----
projectForMyWorld

        ^myProject ifNil: [myProject := myWorld project]!

----- Method: TheWorldMenu>>projectMenu (in category 'construction') -----
projectMenu
	"Build the project menu for the world."
	| menu |

	self flag: #bob0302.

	menu := self menu: 'projects...'.
	self fillIn: menu from: { 
		{ 'save on server (also makes a local copy)' . { #myProject . #storeOnServer } }.
		{ 'save to a different server' . { #myProject . #saveAs } }.
		{ 'save project on local file only' . { #myWorld . #saveOnFile } }.
		{ 'see if server version is more recent...' . { #myProject . #loadFromServer } }.
		{ 'load project from file...' . { self . #loadProject } }.
		nil.
	}.

	self mvcProjectsAllowed ifTrue: [
		self fillIn: menu from: {
			{ 'create new mvc project'. { self . #openMVCProject } }.
		}
	].
	self fillIn: menu from: { 
		{ 'create new morphic project' . { self . #openMorphicProject } }.
		nil.
		{ 'go to previous project' . { Project . #returnToPreviousProject } }.
		{ 'go to next project' . { Project . #advanceToNextProject } }.
		{ 'jump to project...' . { #myWorld . #jumpToProject } }.
	}.
	Preferences simpleMenus ifFalse: [
		self fillIn: menu from: { 
			nil.
			{ 'save for future revert' . { #myProject . #saveForRevert } }.
			{ 'revert to saved copy' . { #myProject . #revert } }.
		}.
	].

	^ menu!

----- Method: TheWorldMenu>>projectThumbnail (in category 'action') -----
projectThumbnail
	"Offer the user a menu of project names. Attach to the hand a thumbnail of the project the user selects."

	| projName pr names values |
	names := OrderedCollection with: Project current name, ' (current)'.
	values := OrderedCollection with: Project current name.
	Project allNames do: [:n | names add: n. values add: n].
	projName := UIManager default 
		chooseFrom: names values: values lines: #(1) title: 'Select a project'.
	projName ifNotNil:
		[(pr := Project named: projName) 
			ifNotNil: [myHand attachMorph: (ProjectViewMorph on: pr)]
			ifNil: [self inform: 'can''t seem to find that project']].!

----- Method: TheWorldMenu>>quitSession (in category 'commands') -----
quitSession

	SmalltalkImage current
		snapshot: (UserDialogBoxMorph 
			confirm: 'Save changes before quitting?' translated 
			orCancel: [^ self]
			at: World center)
		andQuit: true!

----- Method: TheWorldMenu>>readMorphFromAFile (in category 'commands') -----
readMorphFromAFile
	"Produce a morph from a file -- either a saved .morph file or a graphics file"

	| morphOrList ff aName f m |
	aName := Utilities chooseFileWithSuffixFromList:
(#('.morph'), Utilities graphicsFileSuffixes) withCaption: 'Choose a file
to load' translated.
	aName ifNil: [^ self].  "User made no choice"
	aName == #none ifTrue: [^ self inform: 
'Sorry, no suitable files found
(names should end with .morph, .gif,
.bmp, .jpeg, .jpe, .jp, or .form)' translated].

	(aName asLowercase endsWith: '.morph')
		ifTrue:
			[ff := FileStream readOnlyFileNamed: aName.
			morphOrList := ff fileInObjectAndCode.		"code filed in is the Model class"
			"the file may contain either a single morph or an array of morphs"
			myWorld addMorphsAndModel: morphOrList]
		ifFalse:
			[f := Form fromFileNamed: aName.
			f ifNil: [^ self error: 'unrecognized image file format' translated].
			m := myWorld drawingClass new form: f.
			myHand attachMorph: m]
!

----- Method: TheWorldMenu>>remoteDo (in category 'popups') -----
remoteDo

	self doPopUp: self remoteMenu!

----- Method: TheWorldMenu>>remoteMenu (in category 'construction') -----
remoteMenu
        "Build the Telemorphic menu for the world."

        ^self fillIn: (self menu: 'Telemorphic') from: {
                { 'local host address' . { #myWorld . #reportLocalAddress } }.
                { 'connect remote user' . { #myWorld . #connectRemoteUser } }.
                { 'disconnect remote user' . { #myWorld . #disconnectRemoteUser } }.
                { 'disconnect all remote users' . { #myWorld . #disconnectAllRemoteUsers } }.
        }!

----- Method: TheWorldMenu>>roundedCornersString (in category 'action') -----
roundedCornersString

	^ Preferences roundedCornersString!

----- Method: TheWorldMenu>>saveAndQuit (in category 'commands') -----
saveAndQuit

	SmalltalkImage current snapshot: true andQuit: true!

----- Method: TheWorldMenu>>saveScreenshot (in category 'action') -----
saveScreenshot
	"Make a screenshot of the world and save it to a file"

	SampledSound playSoundNamed: 'camera'.
	PNGReadWriter putForm: myWorld imageForm onFileNamed:
		(FileDirectory default nextNameFor: 'SqueakScreen' extension:'png').
!

----- Method: TheWorldMenu>>saveWorldInFile (in category 'commands') -----
saveWorldInFile
	"Save the world's submorphs, model, and stepList in a file.  "

	| fileName fileStream aClass |
	fileName := UIManager default request: 'File name for this morph?'.
	fileName isEmpty ifTrue: [^ self].  "abort"

	"Save only model, stepList, submorphs in this world"
	myWorld submorphsDo: [:m |
		m allMorphsDo: [:subM | subM prepareToBeSaved]].	"Amen"

	fileStream := FileStream newFileNamed: fileName, '.morph'.
	aClass := myWorld model ifNil: [nil] ifNotNil: [myWorld model class].
	fileStream fileOutClass: aClass andObject: myWorld.
!

----- Method: TheWorldMenu>>setDisplayDepth (in category 'commands') -----
setDisplayDepth
	"Let the user choose a new depth for the display. "

	| result oldDepth allDepths allLabels 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)'])].
		]].
	result := UIManager default
		chooseFrom: allLabels 
		values: allDepths 
		title: 'Choose a display depth' translated.
	result ifNotNil: [Display newDepth: result].
	oldDepth := oldDepth abs.
	(Smalltalk isMorphic and: [(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]]]!

----- Method: TheWorldMenu>>setGradientColor (in category 'action') -----
setGradientColor

	myWorld setGradientColor: myHand lastEvent!

----- Method: TheWorldMenu>>soundEnablingString (in category 'action') -----
soundEnablingString

	^ Preferences soundEnablingString!

----- Method: TheWorldMenu>>splitNewMorphList:depth: (in category 'commands') -----
splitNewMorphList: list depth: d 
	| middle c prev next out |
	d <= 0 ifTrue: [^Array with: list].
	middle := list size // 2 + 1.
	c := (list at: middle) name first.
	prev := middle - 1.
	[prev > 0 and: [(list at: prev) name first = c]] 
		whileTrue: [prev := prev - 1].
	next := middle + 1.
	[next <= list size and: [(list at: next) name first = c]] 
		whileTrue: [next := next + 1].
	"Choose the better cluster"
	middle := middle - prev < (next - middle) 
				ifTrue: [prev + 1]
				ifFalse: [next]. 
	middle = 1 ifTrue: [middle := next].
	middle >= list size ifTrue: [middle := prev + 1].
	(middle = 1 or: [middle >= list size]) ifTrue: [^Array with: list].
	out := WriteStream on: Array new.
	out nextPutAll: (self splitNewMorphList: (list copyFrom: 1 to: middle - 1)
				depth: d - 1).
	out 
		nextPutAll: (self splitNewMorphList: (list copyFrom: middle to: list size)
				depth: d - 1).
	^out contents!

----- Method: TheWorldMenu>>staggerPolicyString (in category 'action') -----
staggerPolicyString

	^ Preferences staggerPolicyString!

----- Method: TheWorldMenu>>standardFontDo (in category 'popups') -----
standardFontDo
	"Build and show the standard font menu"

	self doPopUp: Preferences fontConfigurationMenu!

----- Method: TheWorldMenu>>startMessageTally (in category 'commands') -----
startMessageTally

	(self confirm: 'MessageTally will start now,
and stop when the cursor goes
to the top of the screen') ifTrue:
		[MessageTally spyOn:
			[[Sensor peekMousePt y > 0] whileTrue: [World doOneCycle]]]!

----- Method: TheWorldMenu>>suppressFlapsString (in category 'windows & flaps menu') -----
suppressFlapsString
	"Answer the wording of the suppress-flaps item"

	^ Project current suppressFlapsString!

----- Method: TheWorldMenu>>toggleWindowPolicy (in category 'action') -----
toggleWindowPolicy

	Preferences toggleWindowPolicy!

----- Method: TheWorldMenu>>vmStatistics (in category 'commands') -----
vmStatistics
	"Open a string view on a report of vm statistics"

	(StringHolder new contents: SmalltalkImage current  vmStatisticsReportString)
		openLabel: 'VM Statistics'!

----- Method: TheWorldMenu>>windowsDo (in category 'windows & flaps menu') -----
windowsDo
	"Build the windows menu for the world."

	self doPopUp: self windowsMenu!

----- Method: TheWorldMenu>>windowsMenu (in category 'windows & flaps menu') -----
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.'}.

        }!

----- Method: TheWorldMenu>>world:project:hand: (in category 'mechanics') -----
world: aWorld project: aProject hand: aHand

	myWorld := aWorld.
	myProject := aProject.
	myHand := aHand.!

----- Method: TheWorldMenu>>worldMenuHelp (in category 'commands') -----
worldMenuHelp
	| explanation aList |
	"self currentWorld primaryHand worldMenuHelp"

	aList := OrderedCollection new.
	#(helpMenu changesMenu openMenu debugMenu projectMenu scriptingMenu windowsMenu playfieldMenu appearanceMenu flapsMenu) 
		with:
	#('help' 'changes' 'open' 'debug' 'projects' 'authoring tools' 'windows' 'playfield options' 'appearance' 'flaps') do:
		[:sel :title | | aMenu |
		aMenu := self perform: sel.
			aMenu items do:
				[:it | | cnts |
				(((cnts := it contents) = 'keep this menu up') or: [cnts isEmpty])
					ifFalse: [aList add: (cnts, ' - ', title translated)]]].
	aList := aList asSortedCollection: [:a :b | a asLowercase < b asLowercase].

	explanation := String streamContents: [:aStream | aList do:
		[:anItem | aStream nextPutAll: anItem; cr]].

	(StringHolder new contents: explanation)
		openLabel: 'Where in the world menu is...' translated!




More information about the Squeak-dev mailing list