The Trunk: Tools-mt.894.mcz

Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.894.mcz

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

Name: Tools-mt.894
Author: mt
Time: 26 September 2019, 11:51:47.732232 am
UUID: 49cc71d2-c009-b546-a310-b7bc31cd2eb0
Ancestors: Tools-mt.893

Fixes recent regression with "create" button in debugger notifier. Cleans up message categories to make the notifier functionality more clear.

=============== Diff against Tools-mt.893 ===============

Item was changed:
+ ----- Method: Debugger>>askForCategoryIn:default: (in category 'notifier support') -----
- ----- Method: Debugger>>askForCategoryIn:default: (in category 'context stack menu') -----
  askForCategoryIn: aClass default: aString
  | categories index category |
  categories := OrderedCollection with: 'new ...'.
  categories addAll: (aClass allMethodCategoriesIntegratedThrough: Object).
  index := UIManager default  
  chooseFrom: categories
  title: 'Please provide a good category for the new method!!' translated.
  index = 0 ifTrue: [^ aString].
  category := index = 1 ifTrue: [UIManager default request: 'Enter category name:']
  ifFalse: [categories at: index].
  ^ category isEmpty ifTrue: [^ aString] ifFalse: [category]!

Item was changed:
+ ----- Method: Debugger>>askForSuperclassOf:toImplement:ifCancel: (in category 'notifier support') -----
- ----- Method: Debugger>>askForSuperclassOf:toImplement:ifCancel: (in category 'private') -----
  askForSuperclassOf: aClass toImplement: aSelector ifCancel: cancelBlock
  | classes chosenClassIndex |
  classes := aClass withAllSuperclasses.
  chosenClassIndex := UIManager default
  chooseFrom: (classes collect: [:c | c name])
  title: 'Define #', aSelector, ' in which class?'.
  chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
  ^ classes at: chosenClassIndex!

Item was changed:
+ ----- Method: Debugger>>askForSuperclassOf:upTo:toImplement:ifCancel: (in category 'notifier support') -----
- ----- Method: Debugger>>askForSuperclassOf:upTo:toImplement:ifCancel: (in category 'private') -----
  askForSuperclassOf: aClass upTo: superclass toImplement: aSelector ifCancel: cancelBlock
  | classes chosenClassIndex |
  classes := aClass withAllSuperclasses reject: [:cls | aClass isKindOf: cls].
  chosenClassIndex := UIManager default
  chooseFrom: (classes collect: [:c | c name])
  title: 'Define #', aSelector, ' in which class?'.
  chosenClassIndex = 0 ifTrue: [^ cancelBlock value].
  ^ classes at: chosenClassIndex!

Item was changed:
+ ----- Method: Debugger>>contextStackIndex (in category 'context stack - message list') -----
- ----- Method: Debugger>>contextStackIndex (in category 'context stack (message list)') -----
  contextStackIndex
  "Answer the index of the selected context."
 
  ^contextStackIndex!

Item was changed:
+ ----- Method: Debugger>>contextStackList (in category 'context stack - message list') -----
- ----- Method: Debugger>>contextStackList (in category 'context stack (message list)') -----
  contextStackList
  "Answer the array of contexts."
 
  ^contextStackList!

Item was changed:
+ ----- Method: Debugger>>createImplementingMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createImplementingMethod (in category 'private') -----
  createImplementingMethod
  "Should only be called when this Debugger was created in response to a
  NotYetImplemented exception. All we need to do is pop the signalling context off the stack and open the #notYetImplemented method."
  | signallingContext |
+ self initializeFull.
  signallingContext := self selectedContext sender.
  "Pop the signalling context off the stack"
  self resetContext: signallingContext.
  self debug.!

Item was changed:
+ ----- Method: Debugger>>createMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createMethod (in category 'private') -----
  createMethod
  "Should only be called when this Debugger was created in response to a
  MessageNotUnderstood exception. Create a stub for the method that was
  missing and proceed into it."
 
  | msg chosenClass |
+ self initializeFull.
  msg := self contextStackTop exceptionMessage.
  chosenClass := self
  askForSuperclassOf: self contextStackTop receiver class
  toImplement: msg selector
  ifCancel: [^self].
  self implementMissingMethod: msg inClass: chosenClass.!

Item was changed:
+ ----- Method: Debugger>>createOverridingMethod (in category 'notifier buttons') -----
- ----- Method: Debugger>>createOverridingMethod (in category 'private') -----
  createOverridingMethod
  "Should only be called when this Debugger was created in response to a
  SubclassResponsibility exception. Create a stub for the method that needs
  overriding and proceed into it. Let the user only select a class in the
  inheritance chain between the actual class and the class declaring the
  subclassResponsibility."
  | chosenClass msg category |
+ self initializeFull.
  msg := self contextStackTop exceptionMessage.
  chosenClass := self
  askForSuperclassOf: self contextStackTop receiver class
  upTo: self contextStackTop sender method methodClass
  toImplement: msg selector
  ifCancel: [^self].
  "Use the same category as the marker method."
  category := self contextStackTop sender selectorCategory.
  self implementOverridingMethod: msg inClass: chosenClass inCategory: category.!

Item was changed:
+ ----- Method: Debugger>>debugAt: (in category 'notifier buttons') -----
- ----- Method: Debugger>>debugAt: (in category 'initialize') -----
  debugAt: anInteger
  "Opens a full debugger with the given index selected. See #initializeFull to understand why contextStackIndex is set directly."
 
  contextStackIndex := anInteger.
  ^ self debug!

Item was changed:
+ ----- Method: Debugger>>expandNotifierStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>expandNotifierStack (in category 'context stack (message list)') -----
  expandNotifierStack
  "Show a small amount of stack in the context pane. Useful for notifiers."
 
  self okToChange ifFalse: [^ self].
  self newStack: (self contextStackTop stackOfSize: self class notifierStackSize).
  self changed: #contextStackList.
  !

Item was changed:
+ ----- Method: Debugger>>expandStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>expandStack (in category 'context stack (message list)') -----
  expandStack
  "Show a substantial amount of stack in the context pane."
 
  self okToChange ifFalse: [^ self].
  self newStack: (self contextStackTop stackOfSize: self class fullStackSize).
  self changed: #contextStackList.
  !

Item was changed:
+ ----- Method: Debugger>>fullyExpandStack (in category 'context stack - message list') -----
- ----- Method: Debugger>>fullyExpandStack (in category 'context stack (message list)') -----
  fullyExpandStack
  "Expand the stack to include all of it. Well, almost all of it, we better maintain sane limits too."
 
  self okToChange ifFalse: [^ self].
  self newStack: (self contextStackTop stackOfSize: self class stackSizeLimit - contextStack size).
  self changed: #contextStackList.!

Item was changed:
+ ----- Method: Debugger>>implementMissingMethod:inClass: (in category 'notifier support') -----
- ----- Method: Debugger>>implementMissingMethod:inClass: (in category 'context stack menu') -----
  implementMissingMethod: aMessage inClass: aClass
  ^ self
  implementMissingMethod: aMessage
  inClass: aClass
  inCategory: (self askForCategoryIn: aClass default: 'as yet unclassified').!

Item was changed:
+ ----- Method: Debugger>>implementMissingMethod:inClass:inCategory: (in category 'notifier support') -----
- ----- Method: Debugger>>implementMissingMethod:inClass:inCategory: (in category 'context stack menu') -----
  implementMissingMethod: aMessage inClass: aClass inCategory: aSymbol
  "Create a stub implementation of the missing message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
  self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
 
  "Cut out the sender context. This is the context that signalled the MessageNotUnderstood."
  self selectedContext privSender: self selectedContext sender.
  self resetContext: self selectedContext.
  self debug.!

Item was changed:
+ ----- Method: Debugger>>implementOverridingMethod:inClass:inCategory: (in category 'notifier support') -----
- ----- Method: Debugger>>implementOverridingMethod:inClass:inCategory: (in category 'context stack menu') -----
  implementOverridingMethod: aMessage inClass: aClass inCategory: aSymbol
  "Create a stub implementation of the overriding message and sew it onto the top of the stack, ensuring the context's arguments are set correctly. Debug the new context."
  self pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol.
 
  "Cut out the sender context. This is the context that signalled the SubclassResponsibility."
  self selectedContext privSender: self selectedContext sender sender.
  self resetContext: self selectedContext.
  self debug.!

Item was changed:
+ ----- Method: Debugger>>messageHelpAt: (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageHelpAt: (in category 'context stack (message list)') -----
  messageHelpAt: anIndex
  "Show the first n lines of the sources code of the selected message."
 
  | method |
  Preferences balloonHelpInMessageLists ifFalse: [^ nil].
  contextStack size < anIndex ifTrue: [^ nil].
 
  method := (contextStack at: anIndex) method.
  ^ self messageHelpForMethod: method.!

Item was changed:
+ ----- Method: Debugger>>messageIconAt: (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageIconAt: (in category 'context stack (message list)') -----
  messageIconAt: anIndex
 
  Browser showMessageIcons
  ifFalse: [^ nil].
 
  ^ ToolIcons iconNamed: (ToolIcons
  iconForClass: (contextStack at: anIndex) method methodClass
  selector: (contextStack at: anIndex) method selector)!

Item was changed:
+ ----- Method: Debugger>>messageListIndex (in category 'context stack - message list') -----
- ----- Method: Debugger>>messageListIndex (in category 'context stack (message list)') -----
  messageListIndex
  "Answer the index of the currently selected context."
 
  ^contextStackIndex!

Item was removed:
- ----- Method: Debugger>>populateImplementInMenu: (in category 'context stack menu') -----
- populateImplementInMenu: aMenu
-
- | msg |
- msg := self selectedContext at: 1.
- self selectedContext receiver class withAllSuperclasses do:
- [:each |
- aMenu add: each name target: self selector: #implementMissingMethod:inClass: argumentList: (Array with: msg with: each)].
- ^ aMenu
-
- !

Item was changed:
+ ----- Method: Debugger>>selectedMessage (in category 'context stack - message list') -----
- ----- Method: Debugger>>selectedMessage (in category 'context stack (message list)') -----
  selectedMessage
  "Answer the source code of the currently selected context."
  | aContext |
  ^contents := (aContext := self selectedContext) debuggerMap sourceText asText makeSelectorBoldIn: aContext home receiver class!

Item was changed:
+ ----- Method: Debugger>>selectedMessageName (in category 'context stack - message list') -----
- ----- Method: Debugger>>selectedMessageName (in category 'context stack (message list)') -----
  selectedMessageName
  "Answer the message selector of the currently selected context.
  If the method is unbound we can still usefully answer its old selector."
 
  | selector |
  selector := self selectedContext selector.
  ^(selector ~~ self selectedContext method selector
     and: [selector beginsWith: 'DoIt'])
  ifTrue: [self selectedContext method selector]
  ifFalse: [selector]!

Item was changed:
+ ----- Method: Debugger>>toggleContextStackIndex: (in category 'context stack - message list') -----
- ----- Method: Debugger>>toggleContextStackIndex: (in category 'context stack (message list)') -----
  toggleContextStackIndex: anInteger
  "If anInteger is the same as the index of the selected context, deselect it.
  Otherwise, the context whose index is anInteger becomes the selected
  context."
 
  self contextStackIndex:
  (contextStackIndex = anInteger
  ifTrue: [0]
  ifFalse: [anInteger])
  oldContextWas:
  (contextStackIndex = 0
  ifTrue: [nil]
  ifFalse: [contextStack at: contextStackIndex])!