[squeak-dev] The Inbox: Tools-ct.948.mczcommits at source.squeak.org commits at source.squeak.orgMon Feb 24 15:09:57 UTC 2020
Christoph Thiede uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-ct.948.mcz ==================== Summary ==================== Name: Tools-ct.948 Author: ct Time: 24 February 2020, 4:09:52.480226 pm UUID: eca2be99-0120-ab4b-8ccb-326aa4366f49 Ancestors: Tools-mt.940 Minor, non-exhaustive refactorings in the Browser: - Don't reinvent the shouldCopy wheel in #dropOnMessageCategories:at: - Improve multilingual support - Brackets, spaces and use of #ifError: =============== Diff against Tools-mt.940 =============== Item was changed: ----- Method: Browser>>browseAllCommentsForClass (in category 'message functions') ----- browseAllCommentsForClass "Opens a HelpBrowser on the class" | myClass | + myClass := self selectedClassOrMetaClass ifNil: [^ self]. + myClass isTrait ifTrue: [^ self]. - myClass := self selectedClassOrMetaClass ifNil: [ ^self ]. - myClass isTrait ifTrue: [ ^self ]. (Smalltalk classNamed: #HelpBrowser) + ifNil: [^ self inform: 'HelpBrowser is not available.' translated] - ifNil: [ ^self inform: 'HelpBrowser is not available.' ] ifNotNil: [ :HelpBrowser | HelpBrowser openOn: myClass theNonMetaClass ] ! Item was changed: ----- Method: Browser>>buildMessageCategoryListWith: (in category 'toolbuilder') ----- buildMessageCategoryListWith: builder + | listSpec | listSpec := builder pluggableListSpec new. listSpec model: self; list: #messageCategoryList; getIndex: #messageCategoryListIndex; setIndex: #messageCategoryListIndex:; menu: #messageCategoryMenu:; keyPress: #messageCategoryListKey:from:. + SystemBrowser browseWithDragNDrop ifTrue: [ - SystemBrowser browseWithDragNDrop ifTrue:[ listSpec dropAccept: #wantsMessageCategoriesDrop:; + dropItem: #dropOnMessageCategories:at:shouldCopy:]. + ^ listSpec! - dropItem: #dropOnMessageCategories:at:]. - ^listSpec - ! Item was changed: ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | selectedMessageName selector category oldMessageList selectedClassOrMetaClass | selectedMessageName := self selectedMessageName. oldMessageList := self messageList. selectedClassOrMetaClass := self selectedClassOrMetaClass. contents := nil. + selector := selectedClassOrMetaClass newParser parseSelector: aString. - selector := (selectedClassOrMetaClass newParser parseSelector: aString). (self metaClassIndicated and: [(selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A frist-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. category := selectedMessageName ifNil: [ self selectedMessageCategoryName ] ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. selector := selectedClassOrMetaClass compile: aString classified: category notifying: aController. selector == nil ifTrue: [^ nil]. contents := aString copy. self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." selector ~~ selectedMessageName ifTrue: [category = ClassOrganizer nullCategory ifTrue: [self changed: #classSelectionChanged. self changed: #classList. self messageCategoryListIndex: 1]. self setClassOrganizer. "In case organization not cached" (oldMessageList includes: selector) ifFalse: [self changed: #messageList]. self messageListIndex: (self messageList indexOf: selector)]. ^ selector! Item was removed: - ----- Method: Browser>>dropOnMessageCategories:at: (in category 'drag and drop') ----- - dropOnMessageCategories: method at: index - - | sourceClass destinationClass category copy | - copy := Sensor shiftPressed. - (method isKindOf: CompiledMethod) - ifFalse:[^self inform: 'Can only drop methods']. - 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 ]. - (copy - or: [ (destinationClass inheritsFrom: sourceClass) - or: [ (sourceClass inheritsFrom: destinationClass) - or: [ sourceClass theNonMetaClass == destinationClass theNonMetaClass ] ] ]) - ifFalse: [ - (self confirm: ( - 'Classes "{1}" and "{2}" are unrelated.{3}Are you sure you want to move this method?' - format: { sourceClass. destinationClass. Character cr })) - ifFalse: [ ^false ] ]. - destinationClass - compile: method getSource - classified: (self messageCategoryList at: index) - withStamp: method timeStamp - notifying: nil. - copy ifFalse: [ - sourceClass removeSelector: method selector ]. - ^true! Item was added: + ----- Method: Browser>>dropOnMessageCategories:at:shouldCopy: (in category 'drag and drop') ----- + dropOnMessageCategories: method at: index shouldCopy: shouldCopy + + | 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 changed: ----- Method: Browser>>dropOnSystemCategories:at: (in category 'drag and drop') ----- dropOnSystemCategories: aClass at: index + | category | + aClass isBehavior ifFalse: [^ self inform: 'Can only drop classes' translated]. - (aClass isBehavior) ifFalse:[^self inform: 'Can only drop classes']. category := self systemCategoryList at: index. + self selectedEnvironment organization classify: aClass instanceSide name under: category. - self selectedEnvironment organization classify: aClass instanceSide name under: category. self changed: #systemCategoryList. self changed: #classList. + ^ true! - ^true! Item was changed: ----- Method: Browser>>messageHelpAt: (in category 'message list') ----- messageHelpAt: anIndex "Show the first n lines of the sources code of the selected message." + | messageName iconHelp selector method | - | iconHelp selector method | Preferences balloonHelpInMessageLists ifFalse: [^ nil]. + messageName := self messageList at: anIndex ifAbsent: [^ nil]. - self messageList size < anIndex ifTrue: [^ nil]. - "Items in the message list can be formatted texts." self flag: #refactor. + selector := Symbol lookup: messageName asString. - selector := Symbol lookup: (self messageList at: anIndex) asString. selector ifNil: [^ nil]. method := self selectedClassOrMetaClass compiledMethodAt: selector ifAbsent: [^ nil]. iconHelp := (self messageIconHelpFor: method selector) ifNotEmpty: [:t | t , Character cr, Character cr]. ^ iconHelp asText append: (self messageHelpForMethod: method); yourself! Item was changed: ----- Method: Browser>>selectClassNamed: (in category 'class list') ----- selectClassNamed: aSymbolOrString | className currentMessageCategoryName currentMessageName | + currentMessageCategoryName := [self selectedMessageCategoryName] ifError: [nil]. + currentMessageName := [self selectedMessageName] ifError: [nil]. - currentMessageCategoryName := [self selectedMessageCategoryName] - on: Error - do: [:ex| ex return: nil]. - currentMessageName := [self selectedMessageName] - on: Error - do: [:ex| ex return: nil]. selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. self setClassOrganizer. self setClassDefinition. "Try to reselect the category and/or selector if the new class has them." + selectedMessageCategoryName := (self messageCategoryList includes: currentMessageCategoryName) - selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName) ifTrue: [currentMessageCategoryName] ifFalse: [nil]. selectedMessageName := (self messageList includes: currentMessageName) ifTrue: [currentMessageName] ifFalse: [nil]. self hasMessageSelected ifTrue: [self editSelection: #editMessage] ifFalse: [self hasMessageCategorySelected ifTrue: [self editSelection: #newMessage] ifFalse: [self classCommentIndicated ifTrue: [self editSelection: #editComment] ifFalse: [self editSelection: (self hasClassSelected not ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ]) ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]]]. contents := nil. self selectedClass isNil ifFalse: [className := self selectedClass name. (RecentClasses includes: className) ifTrue: [RecentClasses remove: className]. RecentClasses addFirst: className. RecentClasses size > 16 ifTrue: [RecentClasses removeLast]]. self changed: #classSelectionChanged. self changed: #classCommentText. self changed: #classListIndex. "update my selection" self changed: #messageCategoryList. self changed: #messageList. self changed: #relabel. self changed: #selectedSystemCategoryName. self contentsChanged!
More information about the Squeak-dev mailing list |