[squeak-dev] The Inbox: Tools-ct.949.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Feb 24 19:50:40 UTC 2020


Christoph Thiede uploaded a new version of Tools to project The Inbox:
http://source.squeak.org/inbox/Tools-ct.949.mcz

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

Name: Tools-ct.949
Author: ct
Time: 24 February 2020, 8:50:34.841226 pm
UUID: f9a17e04-06ff-4347-99d1-ed2dcfdba1ca
Ancestors: Tools-ct.948

Adds support for dragging methods on a class in a browser

=============== Diff against Tools-ct.948 ===============

Item was changed:
  ----- Method: Browser>>buildClassListWith: (in category 'toolbuilder') -----
  buildClassListWith: builder
+ 	
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #classList;
  		getIndex: #classListIndex; 
  		setIndex: #classListIndex:;
  		icon: #classIconAt:; 
  		menu: #classListMenu:shifted:; 
  		keyPress: #classListKey:from:.
+ 	SystemBrowser browseWithDragNDrop ifTrue: [
+ 		listSpec
+ 			dragItem: #dragFromClassList:;
+ 			dropAccept: #wantsClassListDrop:;
+ 			dropItem: #dropOnClassList:at:shouldCopy:].
+ 	^ listSpec
- 	SystemBrowser browseWithDragNDrop 
- 		ifTrue:[listSpec dragItem: #dragFromClassList:].
- 
- 	^listSpec
  !

Item was added:
+ ----- Method: Browser>>dropOnClassList:at:shouldCopy: (in category 'drag and drop') -----
+ dropOnClassList: method at: index shouldCopy: shouldCopy
+ 
+ 	^ self
+ 		moveMethod: method
+ 		shouldCopy: shouldCopy
+ 		class: (self environment classNamed: (self defaultClassList at: index))
+ 		category: [:sourceClass :areClassesRelated |
+ 			areClassesRelated
+ 				ifTrue: [sourceClass whichCategoryIncludesSelector: method selector]
+ 				ifFalse: [nil]]!

Item was changed:
  ----- Method: Browser>>dropOnMessageCategories:at:shouldCopy: (in category 'drag and drop') -----
  dropOnMessageCategories: method at: index shouldCopy: shouldCopy
  
+ 	^ self
+ 		moveMethod: method
+ 		shouldCopy: shouldCopy
+ 		class: self selectedClassOrMetaClass
+ 		category: (self messageCategoryList at: index)!
- 	| sourceClass destinationClass category |
- 	(method isKindOf: CompiledMethod) 
- 		ifFalse: [^ self inform: 'Can only drop methods' translated].
- 	sourceClass := method methodClass.
- 	destinationClass := self selectedClassOrMetaClass.
- 	sourceClass == destinationClass ifTrue: [
- 		category := self messageCategoryList at: index.
- 		category = ClassOrganizer allCategory ifTrue: [^ false].
- 		destinationClass organization classify: method selector under: category suppressIfDefault: false logged: true.
- 		self changed: #messageCategoryList.
- 		self changed: #messageList.
- 		^ true ].
- 	(shouldCopy
- 		or: [ (destinationClass inheritsFrom: sourceClass) ]
- 		or: [ (sourceClass inheritsFrom: destinationClass) ]
- 		or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ])
- 		ifFalse: [
- 			(self confirm: (
- 				'Classes "{1}" and "{2}" are unrelated.\Are you sure you want to move this method?' withCRs translated
- 					format: { sourceClass. destinationClass })) 
- 						ifFalse: [ ^ false ] ].
- 	destinationClass
- 		compile: method getSource
- 		classified: (self messageCategoryList at: index)
- 		withStamp: method timeStamp
- 		notifying: nil.
- 	shouldCopy ifFalse: [
- 		sourceClass removeSelector: method selector ].
- 	self selectMessageNamed: method selector.
- 	^ true!

Item was added:
+ ----- Method: Browser>>moveMethod:shouldCopy:class:category: (in category 'drag and drop') -----
+ moveMethod: method shouldCopy: shouldCopy class: destinationClass category: categoryOrBlock
+ 
+ 	| sourceClass areClassesRelated category |
+ 	(method isKindOf: CompiledMethod) 
+ 		ifFalse: [^ self inform: 'Can only drop methods' translated].
+ 	sourceClass := method methodClass.
+ 	areClassesRelated := (destinationClass inheritsFrom: sourceClass)
+ 		or: [ (sourceClass inheritsFrom: destinationClass) ]
+ 		or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ].
+ 	(shouldCopy or: [areClassesRelated]) ifFalse: [
+ 		(self confirm: ('Classes "{1}" and "{2}" are unrelated.\Are you sure you want to move this method?' withCRs translated
+ 			format: { sourceClass. destinationClass })) 
+ 				ifFalse: [ ^ false ] ].
+ 	category := categoryOrBlock isBlock
+ 		ifTrue: [categoryOrBlock value: sourceClass value: areClassesRelated]
+ 		ifFalse: [categoryOrBlock].
+ 	sourceClass == destinationClass
+ 		ifTrue: [
+ 			category = ClassOrganizer allCategory ifTrue: [^ false].
+ 			destinationClass organization classify: method selector under: category suppressIfDefault: false logged: true ]
+ 		ifFalse: [
+ 			destinationClass
+ 				compile: method getSource
+ 				classified: category
+ 				withStamp: method timeStamp
+ 				notifying: nil.
+ 			shouldCopy ifFalse: [
+ 				sourceClass removeSelector: method selector ] ].
+ 	self setClass: destinationClass selector: method selector.
+ 	^ true!



More information about the Squeak-dev mailing list