[squeak-dev] The Trunk: Morphic-mt.1026.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Nov 4 17:50:06 UTC 2015


Marcel Taeumel uploaded a new version of Morphic to project The Trunk:
http://source.squeak.org/trunk/Morphic-mt.1026.mcz

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

Name: Morphic-mt.1026
Author: mt
Time: 4 November 2015, 6:49:25.917 pm
UUID: a15f3e14-7c49-4d00-988f-ab69d4a499f8
Ancestors: Morphic-mt.1025

Refactors and cleans-up drag-and-drop mechanism used by pluggable lists and trees.

=============== Diff against Morphic-mt.1025 ===============

Item was changed:
  ----- Method: PluggableListMorph>>startDrag: (in category 'drag and drop') -----
  startDrag: evt 
+ 
+ 	| item itemMorph |	
+ 	evt hand hasSubmorphs ifTrue: [^ self].
+ 	self model okToChange ifFalse: [^ self].
+ 
+ 	item := self selection ifNil: [^ self].
+ 	itemMorph := StringMorph contents: item asStringOrText.
  	
+ 	[ "Initiate drag."
+ 		(self model dragPassengerFor: itemMorph inMorph: self) ifNotNil: [:passenger | | ddm |
+ 			ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
+ 			ddm dragTransferType: (self model dragTransferTypeForMorph: self).
+ 			ddm updateFromUserInputEvent: evt.
+ 			self model dragStartedFor: itemMorph transferMorph: ddm.
+ 			evt hand grabMorph: ddm]
+ 	] ensure: [
+ 		Cursor normal show.
+ 		evt hand releaseMouseFocus: self].!
- 	evt hand hasSubmorphs
- 		ifTrue: [^ self].
- 	[ | draggedItem draggedItemMorph passenger ddm |
- 	(self dragEnabled and: [model okToChange])
- 		ifFalse: [^ self].
- 	(draggedItem := self selection)
- 		ifNil: [^ self].
- 	draggedItemMorph := StringMorph contents: draggedItem asStringOrText.
- 	passenger := self model dragPassengerFor: draggedItemMorph inMorph: self.
- 	passenger
- 		ifNil: [^ self].
- 	ddm := TransferMorph withPassenger: passenger from: self.
- 	ddm
- 		dragTransferType: (self model dragTransferTypeForMorph: self).
- 	Preferences dragNDropWithAnimation
- 		ifTrue: [self model dragAnimationFor: draggedItemMorph transferMorph: ddm].
- 	evt hand grabMorph: ddm]
- 		ensure: [Cursor normal show.
- 			evt hand releaseMouseFocus: self]!

Item was changed:
+ ----- Method: PluggableListMorph>>wantsDroppedMorph:event: (in category 'drag and drop') -----
- ----- Method: PluggableListMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
  wantsDroppedMorph: aMorph event: anEvent 
  	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self!

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>acceptDroppingMorph:event: (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>acceptDroppingMorph:event: (in category 'dropping/grabbing') -----
  acceptDroppingMorph: aMorph event: evt
  
  	self model
  		acceptDroppingMorph: aMorph
  		event: evt
  		inMorph: self.
  	self resetPotentialDropMorph.
  	evt hand releaseMouseFocus: self.
  	Cursor normal show.
  !

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph (in category 'dropping/grabbing') -----
  potentialDropMorph
  	^potentialDropMorph!

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph: (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>potentialDropMorph: (in category 'dropping/grabbing') -----
  potentialDropMorph: aMorph
  	potentialDropMorph := aMorph.
  	aMorph highlightForDrop!

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>resetPotentialDropMorph (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>resetPotentialDropMorph (in category 'dropping/grabbing') -----
  resetPotentialDropMorph
  	potentialDropMorph ifNotNil: [
  		potentialDropMorph resetHighlightForDrop.
  		potentialDropMorph := nil]
  !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>setSelectedMorph: (in category 'selection') -----
  setSelectedMorph: aMorph
  
+ 	"Avoid unnecessary model callbacks."
+ 	self selectedMorph == aMorph ifTrue: [^ self].
+ 
  	model 
  		perform: (setSelectionSelector ifNil: [^self]) 
  		with: aMorph complexContents	"leave last wrapper in place"
  
   !

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>startDrag: (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>startDrag: (in category 'event handling') -----
  startDrag: evt 
+ 	
+ 	| itemMorph |
+ 	evt hand hasSubmorphs ifTrue: [^ self].
+ 	self model okToChange ifFalse: [^ self].
+ 	
+ 	itemMorph := scroller submorphs
+ 		detect: [:any | any highlightedForMouseDown]
+ 		ifNone: [^ self].
+ 
+ 	"Prepare visuals."
- 	| ddm itemMorph passenger |
- 	self dragEnabled
- 		ifTrue: [itemMorph := scroller submorphs
- 						detect: [:any | any highlightedForMouseDown]
- 						ifNone: []].
- 	(itemMorph isNil
- 			or: [evt hand hasSubmorphs])
- 		ifTrue: [^ self].
  	itemMorph highlightForMouseDown: false.
+ 	self setSelectedMorph: itemMorph.
+ 
+ 	[ "Initiate drag."
+ 		(self model dragPassengerFor: itemMorph inMorph: self) ifNotNil: [:passenger | | ddm |
+ 			ddm := (self valueOfProperty: #dragTransferClass ifAbsent: [TransferMorph]) withPassenger: passenger from: self.
+ 			ddm dragTransferType: (self model dragTransferTypeForMorph: self).
+ 			ddm updateFromUserInputEvent: evt.
+ 			self model dragStartedFor: itemMorph transferMorph: ddm.
- 	itemMorph ~= self selectedMorph
- 		ifTrue: [self setSelectedMorph: itemMorph].
- 	passenger := self model dragPassengerFor: itemMorph inMorph: self.
- 	passenger
- 		ifNotNil: [ddm := TransferMorph withPassenger: passenger from: self.
- 			ddm
- 				dragTransferType: (self model dragTransferTypeForMorph: self).
- 			Preferences dragNDropWithAnimation
- 				ifTrue: [self model dragAnimationFor: itemMorph transferMorph: ddm].
  			evt hand grabMorph: ddm].
+ 	] ensure: [
+ 		Cursor normal show.
+ 		evt hand releaseMouseFocus: self].!
- 	evt hand releaseMouseFocus: self!

Item was changed:
+ ----- Method: SimpleHierarchicalListMorph>>wantsDroppedMorph:event: (in category 'drag and drop') -----
- ----- Method: SimpleHierarchicalListMorph>>wantsDroppedMorph:event: (in category 'dropping/grabbing') -----
  wantsDroppedMorph: aMorph event: anEvent 
  	^ self model wantsDroppedMorph: aMorph event: anEvent inMorph: self!

Item was changed:
  ----- Method: TransferMorph class>>withPassenger: (in category 'instance creation') -----
  withPassenger: anObject 
+ 
+ 	^ self
+ 		withPassenger: anObject
+ 		from: nil!
- 	^ self withPassenger: anObject from: nil!

Item was changed:
  ----- Method: TransferMorph class>>withPassenger:from: (in category 'instance creation') -----
  withPassenger: anObject from: source 
+ 	
+ 	^ self new
+ 		passenger: anObject;
+ 		source: source;
+ 		yourself!
- 	| ddm |
- 	ddm := self new.
- 	ddm passenger: anObject.
- 	ddm source: source.
- 	Sensor shiftPressed ifTrue: [ddm shouldCopy: true].
- 	^ ddm!

Item was changed:
  ----- Method: TransferMorph>>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."
  	"Since this morph has been initialized automatically with bounds origin   
  	     0 at 0, we have to move it to aHand position."
  	super aboutToBeGrabbedBy: aHand.
+ 
+ 	self align: self fullBounds bottomLeft with: aHand position.
- 	self draggedMorph.
- 	self align: self bottomLeft with: aHand position.
  	aHand newKeyboardFocus: self.!

Item was removed:
- ----- Method: TransferMorph>>delete (in category 'submorphs-add/remove') -----
- delete
- 	"See also >>justDroppedInto:event:."
- 	self changed: #deleted.
- 	self breakDependents.
- 	super delete!

Item was added:
+ ----- Method: TransferMorph>>doCopy (in category 'event handling') -----
+ doCopy
+ 
+ 	copy := true.
+ 	self updateCopyIcon.!

Item was added:
+ ----- Method: TransferMorph>>doMove (in category 'event handling') -----
+ doMove
+ 
+ 	copy := false.
+ 	self updateCopyIcon.!

Item was changed:
+ ----- Method: TransferMorph>>dragTransferType (in category 'accessing') -----
- ----- Method: TransferMorph>>dragTransferType (in category 'drag and drop') -----
  dragTransferType
  	^transferType!

Item was removed:
- ----- Method: TransferMorph>>draggedMorph (in category 'accessing') -----
- draggedMorph
- 	draggedMorph ifNil: [self initDraggedMorph].
- 	^draggedMorph!

Item was removed:
- ----- Method: TransferMorph>>draggedMorph: (in category 'accessing') -----
- draggedMorph: aMorph
- 	draggedMorph := aMorph!

Item was removed:
- ----- Method: TransferMorph>>initDraggedMorph (in category 'private') -----
- initDraggedMorph
- 	draggedMorph ifNotNil: [^self].
- 	draggedMorph := self passenger asDraggableMorph.
- 	self addMorphBack: draggedMorph.
- 	self updateCopyIcon.
- 	self changed; fullBounds!

Item was changed:
  ----- Method: TransferMorph>>initialize (in category 'initialization') -----
  initialize
+ 
- 	"initialize the state of the receiver"
  	super initialize.
+ 
+ 	self
+ 		changeTableLayout;
+ 		listDirection: #leftToRight;
- 	self layoutPolicy: TableLayout new.
- 	self listDirection: #leftToRight;
  		hResizing: #shrinkWrap;
  		vResizing: #shrinkWrap;
  		layoutInset: 3;
+ 		cellInset: 3;
  		wrapCentering: #center;
+ 		cellPositioning: #leftCenter;
+ 		setProperty: #indicateKeyboardFocus toValue: #never.
+ 	
+ 	self doMove.
+ 	
+ 	self on: #keyStroke send: #keyStroke: to: self.
+ 	self on: #keyUp send: #updateFromUserInputEvent: to: self.
+ 	self on: #keyDown send: #updateFromUserInputEvent: to: self.!
- 		cellPositioning: #leftCenter.
- 	copy := false.
- 	self on: #keyStroke send: #keyStroke: to: self!

Item was changed:
  ----- Method: TransferMorph>>keyStroke: (in category 'event handling') -----
  keyStroke: evt
  	"Abort the drag on an escape"
+ 
+ 	evt keyCharacter = Character escape ifTrue: [self delete].!
- 	evt keyCharacter ~= Character escape ifTrue: [ ^self ].
- 	self delete.!

Item was removed:
- ----- Method: TransferMorph>>move (in category 'accessing') -----
- move
- 	copy := false!

Item was changed:
  ----- Method: TransferMorph>>passenger: (in category 'accessing') -----
  passenger: anObject
+ 
+ 	passenger := anObject.
+ 
+ 	self
+ 		removeAllMorphs;
+ 		addMorph: passenger asDraggableMorph;
+ 		updateCopyIcon.!
- 	passenger := anObject!

Item was removed:
- ----- Method: TransferMorph>>privateFullMoveBy: (in category 'private') -----
- privateFullMoveBy: delta 
- 	super privateFullMoveBy: delta.
- 	self changed: #position!

Item was removed:
- ----- Method: TransferMorph>>shouldCopy: (in category 'accessing') -----
- shouldCopy: aBoolean
- 	copy := aBoolean.!

Item was added:
+ ----- Method: TransferMorph>>shouldMove (in category 'accessing') -----
+ shouldMove
+ 	^ self shouldCopy not!

Item was removed:
- ----- Method: TransferMorph>>step (in category 'stepping and presenter') -----
- step
- 	self shouldCopy: self primaryHand lastEvent shiftPressed.
- 	self updateCopyIcon!

Item was removed:
- ----- Method: TransferMorph>>stepTime (in category 'stepping and presenter') -----
- stepTime
- 	^100!

Item was changed:
  ----- Method: TransferMorph>>updateCopyIcon (in category 'private') -----
  updateCopyIcon
+ 
+ 	(self submorphNamed: #tmCopyIcon)
+ 		ifNil: [self shouldCopy ifTrue: [
+ 			self addMorphFront: (ImageMorph new image: CopyPlusIcon; name: #tmCopyIcon; yourself)]]
+ 		ifNotNil: [:copyIcon | self shouldCopy ifFalse: [
+ 			copyIcon delete]]!
- 	| copyIcon |
- 	copyIcon := self submorphWithProperty: #tmCopyIcon.
- 	(self shouldCopy and: [ copyIcon isNil ]) ifTrue: [
- 		^self addMorphFront: ((ImageMorph new image: CopyPlusIcon) setProperty: #tmCopyIcon toValue: true)
- 	].
- 	(self shouldCopy not and: [ copyIcon notNil ]) ifTrue: [
- 		copyIcon delete
- 	]!

Item was added:
+ ----- Method: TransferMorph>>updateFromUserInputEvent: (in category 'event handling') -----
+ updateFromUserInputEvent: evt
+ 
+ 	evt shiftPressed
+ 		ifTrue: [self doCopy]
+ 		ifFalse: [self doMove].!

Item was removed:
- Morph subclass: #TransferMorphAnimation
- 	instanceVariableNames: 'transferMorph'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Morphic-Support'!

Item was removed:
- ----- Method: TransferMorphAnimation class>>on: (in category 'instance creation') -----
- on: aTransferMorph
- 	^self new on: aTransferMorph!

Item was removed:
- ----- Method: TransferMorphAnimation>>on: (in category 'initialization') -----
- on: aTransferMorph
- 
- 	self flag: #bob.		"there was a reference to World, but the class seems to be unused"
- 
- 	self color: Color transparent.
- 	transferMorph := aTransferMorph.
- 	transferMorph addDependent: self.
- 	ActiveWorld addMorph: self	"or perhaps aTransferMorph world"!

Item was removed:
- ----- Method: TransferMorphAnimation>>transferMorph (in category 'accessing') -----
- transferMorph
- 	^transferMorph!

Item was removed:
- ----- Method: TransferMorphAnimation>>update: (in category 'updating') -----
- update: aSymbol	
- 	aSymbol == #deleted
- 		ifTrue: [self delete].
- 	aSymbol == #position
- 		ifTrue: [self updateAnimation].
- 	self changed!

Item was removed:
- ----- Method: TransferMorphAnimation>>updateAnimation (in category 'update') -----
- updateAnimation!

Item was removed:
- TransferMorphAnimation subclass: #TransferMorphLineAnimation
- 	instanceVariableNames: 'polygon'
- 	classVariableNames: ''
- 	poolDictionaries: ''
- 	category: 'Morphic-Support'!

Item was removed:
- ----- Method: TransferMorphLineAnimation>>initPolygon (in category 'initialization') -----
- initPolygon
- 	polygon := (LineMorph from: self transferMorph source bounds center
- 				to: self transferMorph bounds center
- 				color: Color black width: 2)
- 			dashedBorder: {10. 10. Color white}.
- 	self addMorph: polygon
- !

Item was removed:
- ----- Method: TransferMorphLineAnimation>>on: (in category 'initialization') -----
- on: aTransferMorph
- 	super on: aTransferMorph.
- 	self initPolygon!

Item was removed:
- ----- Method: TransferMorphLineAnimation>>updateAnimation (in category 'update') -----
- updateAnimation
- 	polygon verticesAt: 2 put: self transferMorph center!



More information about the Squeak-dev mailing list