[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
|