[Pkg] The Trunk: Morphic-cmm.477.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Dec 5 17:59:55 UTC 2010


Chris Muller uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-cmm.477.mcz

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

Name: Morphic-cmm.477
Author: cmm
Time: 5 December 2010, 11:26:13.44 am
UUID: e67e92c7-628c-499f-a153-3ce2c6c938f4
Ancestors: Morphic-cmm.476

- Updates from Connectors; for better loading into 4.2.

=============== Diff against Morphic-cmm.476 ===============

Item was changed:
  ----- Method: HaloMorph>>doDup:with: (in category 'private') -----
  doDup: evt with: dupHandle
  	"Ask hand to duplicate my target."
  
+ 	(target isSelectionMorph) ifTrue:
- 	(target isKindOf: SelectionMorph) ifTrue:
  		[^ target doDup: evt fromHalo: self handle: dupHandle].
  
  	self obtainHaloForEvent: evt andRemoveAllHandlesBut: dupHandle.
  	self setTarget: (target duplicateMorph: evt).
  	evt hand grabMorph: target.
  	self step. "update position if necessary"
  	evt hand addMouseListener: self. "Listen for the drop"!

Item was changed:
  ----- 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 addMorphFrontFromWorldPosition: self!
- 	target addMorphFront: self fromWorldPosition: self positionInWorld.!

Item was added:
+ ----- Method: Morph>>isSelectionMorph (in category 'testing') -----
+ isSelectionMorph
+ 	^false!

Item was changed:
  ----- 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."
- 	name. "
- 
  	| aPresenter putInViewer aPasteUp renderer oldKey assoc classes oldName |
  	oldName := self knownName.
+ 	oldName=aName ifTrue: [ ^aName ].
  	(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!

Item was changed:
  ----- Method: Morph>>slideToTrash: (in category 'dropping/grabbing') -----
  slideToTrash: evt
  	"Perhaps slide the receiver across the screen to a trash can and make it disappear into it.  In any case, remove the receiver from the screen."
  
  	| aForm trash startPoint endPoint morphToSlide |
  	((self renderedMorph == Utilities scrapsBook) or: [self renderedMorph isKindOf: TrashCanMorph]) ifTrue:
  		[self dismissMorph.  ^ self].
  	Preferences slideDismissalsToTrash ifTrue:
  		[morphToSlide := self representativeNoTallerThan: 200 norWiderThan: 200 thumbnailHeight: 100.
  		aForm := morphToSlide imageForm offset: (0 at 0).
  		trash := ActiveWorld
  			findDeepSubmorphThat:
  				[:aMorph | (aMorph isKindOf: TrashCanMorph) and:
  					[aMorph topRendererOrSelf owner == ActiveWorld]]
  			ifAbsent:
  				[trash := TrashCanMorph new.
+ 				trash position: ActiveWorld bottomLeft - (0 @ (trash extent y + 26)).
- 				trash bottomLeft: ActiveWorld bottomLeft - (-10 at 10).
  				trash openInWorld.
  				trash].
  		endPoint := trash fullBoundsInWorld center.
  		startPoint := self topRendererOrSelf fullBoundsInWorld center - (aForm extent // 2)].
  	self dismissMorph.
  	ActiveWorld displayWorld.
  	Preferences slideDismissalsToTrash ifTrue:
  		[aForm slideFrom: startPoint to: endPoint nSteps: 12 delay: 15].
  	Utilities addToTrash: self!

Item was changed:
  ----- Method: PasteUpMorph>>deleteAllHalos (in category 'world state') -----
  deleteAllHalos
+ 	self haloMorphs do:
+ 		[ : m | m target isSelectionMorph ifTrue: [ m target delete ] ].
+ 	self hands do:
+ 		[ : each | each removeHalo ]!
- 
- 	self haloMorphs
- 		do: [:each | (each target isKindOf: SelectionMorph)
- 				ifTrue: [each target delete]].
- 	self hands
- 		do: [:each | each removeHalo]!

Item was added:
+ ----- Method: SelectionMorph>>isSelectionMorph (in category 'testing') -----
+ isSelectionMorph
+ 	^true!

Item was changed:
  ----- Method: StringMorph>>minHeight (in category 'connectors-layout') -----
  minHeight
  "answer the receiver's minHeight"
+ 	^ super minHeight max: self fontToUse height!
- 	^ self fontToUse height!



More information about the Packages mailing list