'From Squeakland 3.8.5976 of 25 August 2004 [latest update: #347] on 14 October 2004 at 11:43:15 am'! "Change Set: TooManyViewersFix-nk Date: 14 October 2004 Author: Ned Konz Fixes a problem introduced in CS 0341EmbeddingFixes-nk by avoids opening viewers for all embedded morphs. Also fixes a problem with deletion of objects from the world. "! !CompoundTileMorph methodsFor: 'access' stamp: 'nk 10/14/2004 11:37'! myMorph ^nil! ! !Presenter methodsFor: '*connectors-viewer' stamp: 'nk 10/13/2004 09:46'! viewMorph: aMorph | aPlayer aViewer aPalette aRect aPoint nominalHeight aFlapTab topItem flapLoc | "Also view its pins, if any" aMorph allMorphsWithPlayersDo: [ :mwp :p | (mwp ~~ aMorph and: [ mwp wantsConnectionWhenEmbedded ]) ifTrue: [ self viewMorph: mwp ]]. Sensor leftShiftDown ifFalse: [((aPalette := aMorph standardPalette) notNil and: [aPalette isInWorld]) ifTrue: [^aPalette viewMorph: aMorph]]. aPlayer := (topItem := aMorph topRendererOrSelf) assuredPlayer. aViewer := (aPlayer allOpenViewers at: 1 ifAbsent: [ self nascentPartsViewer ]). self cacheSpecs: topItem. "redo the spec cache once in a while" "19 sept 2000 - allow flaps in any paste up" flapLoc := associatedMorph. "world" Preferences viewersInFlaps ifTrue: [ aViewer owner ifNotNilDo: [ :f | ^f flapTab showFlap; yourself ]. aViewer setProperty: #noInteriorThumbnail toValue: true. aViewer initializeFor: aPlayer barHeight: 0. aViewer enforceTileColorPolicy. aViewer fullBounds. "force layout" "associatedMorph addMorph: aViewer." "why???" flapLoc hideViewerFlapsOtherThanFor: aPlayer. aFlapTab := flapLoc viewerFlapTabFor: topItem. aFlapTab referent submorphs do: [:m | (m isKindOf: Viewer) ifTrue: [m delete]]. aViewer visible: true. aFlapTab applyThickness: aViewer width + 25. aFlapTab spanWorld. aFlapTab showFlap. aViewer position: aFlapTab referent position. aFlapTab referent addMorph: aViewer beSticky. "moved" flapLoc startSteppingSubmorphsOf: aFlapTab. flapLoc startSteppingSubmorphsOf: aViewer. ^aFlapTab]. aViewer initializeFor: aPlayer barHeight: 6. aViewer enforceTileColorPolicy. aViewer fullBounds. "force layout" Preferences automaticViewerPlacement ifTrue: [aPoint := aMorph bounds right @ (aMorph center y - ((nominalHeight := aViewer initialHeightToAllow) // 2)). aRect := (aPoint extent: aViewer width @ nominalHeight) translatedToBeWithin: flapLoc bounds. aViewer position: aRect topLeft. aViewer visible: true. associatedMorph addMorph: aViewer. flapLoc startSteppingSubmorphsOf: aViewer. "it's already in the world, somewhat coincidentally" ^aViewer]. aMorph primaryHand attachMorph: (aViewer visible: true). ^aViewer! !