The Inbox: Tools-ct.948.mcz

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!