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

commits at source.squeak.org commits at source.squeak.org
Sat Mar 7 15:10:28 UTC 2020


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

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

Name: Tools-ct.953
Author: ct
Time: 7 March 2020, 4:10:20.216886 pm
UUID: ea98d031-7628-1845-afd3-eecefe81a576
Ancestors: Tools-ct.948

Adds support for dragging methods on a class in a browser

Committed a third time and replaces Tools-ct.950 (use #isCompiledMethod).

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

Item was changed:
  ----- Method: Browser>>buildMessageListWith: (in category 'toolbuilder') -----
  buildMessageListWith: builder
  	| listSpec |
  	listSpec := builder pluggableListSpec new.
  	listSpec 
  		model: self;
  		list: #messageList; 
  		getIndex: #messageListIndex; 
  		setIndex: #messageListIndex:; 
  		icon: #messageIconAt:;
  		helpItem: #messageHelpAt:;
  		menu: #messageListMenu:shifted:; 
  		keyPress: #messageListKey:from:.
+ 	SystemBrowser browseWithDragNDrop ifTrue: [
+ 		listSpec
+ 			dragItem: #dragFromMessageList:;
+ 			draggedItem: #draggedFromMessageList:wasCopy:].
- 	SystemBrowser browseWithDragNDrop 
- 		ifTrue:[listSpec dragItem: #dragFromMessageList:].
  	^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 hierarchicalClassList at: index) withBlanksTrimmed)
+ 		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!

Item was added:
+ ----- Method: Browser>>wantsClassListDrop: (in category 'drag and drop') -----
+ wantsClassListDrop: anObject
+ 	
+ 	^ anObject isCompiledMethod!



More information about the Squeak-dev mailing list