Re: The Trunk: Morphic-Kernel-chc.1.mcz

> 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@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@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@0 extent: 250@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@0 extent: 250@120) rule: Form over fillColor: Color white.
>        ofs := (owner hands indexOf: self) - 1 * 60.
>        evt printString displayAt: (0@ofs) + (evt isKeyboard ifTrue:[0@30] ifFalse:[0@0]).
>        self keyboardFocus printString displayAt: (0@ofs)+(0@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@ofs) + (0@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@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@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@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@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@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@4) extent: (f widthOfString: userInitials)@(f height).
>        ].
>        self userPicture: aForm.
>        aForm ifNotNil: [
>                pictRect := (self cursorBounds topRight + (0@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@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@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@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@0)
> !
>
> ----- Method: Morph>>altSpecialCursor1 (in category 'debug and other') -----
> altSpecialCursor1
>        "a star and an arrow"
>        ^(Form
>        extent: 31@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@0)!
>
> ----- Method: Morph>>altSpecialCursor2 (in category 'debug and other') -----
> altSpecialCursor2
>        | f |
>        "a blue box with transparent center"
>        f := Form extent: 32@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@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@-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@0.
> patchBelowMe displayAt: 100@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@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@window labelHeight) + window borderWidth))
>                                                corner: self bottomRight + window borderWidth).
>        window addMorph: self frame: (0@0 extent: 1@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@0 extent: 1@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@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@0 extent: 1@gridForm height) fillColor: lineColor].
>        gridOrigin y to: gridForm height by: smallGrid y do:
>                [:y | gridForm fill: (0@y extent: gridForm width@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@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@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@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@200)!
>
> ----- Method: Morph>>inspectInMorphic: (in category 'menus') -----
> inspectInMorphic: evt
>        evt hand attachMorph: ((ToolSet inspect: self) extent: 300@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@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@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@0 extent: 1@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@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@0) and: [self position = (0@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@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@100).
>        dummy topLeft: 50@50; extent: ext.      "reset when comes in"
>        str := (TextMorph new) topLeft: dummy topLeft + (10@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@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@0]
>                        ifNotNil: [
>                                bRect := partiallyOutside
>                                        ifTrue: [boundingMorph bounds insetBy:
>                                                                self extent negated + boundingMorph borderWidth + (2@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@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@0).
>                trash := ActiveWorld
>                        findDeepSubmorphThat:
>                                [:aMorph | (aMorph isKindOf: TrashCanMorph) and:
>                                        [aMorph topRendererOrSelf owner == ActiveWorld]]
>                        ifAbsent:
>                                [trash := TrashCanMorph new.
>                                trash bottomLeft: ActiveWorld bottomLeft - (-10@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@0.
> patchBelowMe displayAt: 100@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@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@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@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@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@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@0 extent: 1@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@0 extent: 1@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@140 extent: 560@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@140 extent: 560@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@100.                                               "obtain a new point"
> y := x x.                                                   "x coordinate"
> y := x y.                                                   "y coordinate"
> x := 200@100 negated.                                       "negates x and y"
> x := (-200@-100) abs.                                       "absolute value of x and y"
> x := (200.5@100.5) rounded.                                 "round x and y"
> x := (200.5@100.5) truncated.                               "truncate x and y"
> x := 200@100 + 100.                                         "add scale to both x and y"
> x := 200@100 - 100.                                         "subtract scale from both x and y"
> x := 200@100 * 2.                                           "multiply x and y by scale"
> x := 200@100 / 2.                                           "divide x and y by scale"
> x := 200@100 // 2.                                          "divide x and y by scale"
> x := 200@100 \\ 3.                                          "remainder of x and y by scale"
> x := 200@100 + 50@25.                                       "add points"
> x := 200@100 - 50@25.                                       "subtract points"
> x := 200@100 * 3@4.                                         "multiply points"
> x := 200@100 // 3@4.                                        "divide points"
> x := 200@100 max: 50@200.                                   "max x and y"
> x := 200@100 min: 50@200.                                   "min x and y"
> x := 20@5 dotProduct: 10@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@200.                                        "move to specified point"
> myPen place: 250@250.                                       "move to specified point without drawing"
> myPen print: ''Hello World'' withFont: (TextStyle default fontAt: 1).
> Display extent.                                             "get display width@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@140 extent: 500@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@160 extent: 500@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@180 extent: 500@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@180 extent: 600@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@200 extent: 500@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!
>
>