The Trunk: Tools-fbs.445.mcz

Frank Shearar uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-fbs.445.mcz

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

Name: Tools-fbs.445
Author: fbs
Time: 5 February 2013, 11:14:02.879 pm
UUID: 87b52e34-e0e6-4fad-bbf3-5187979c3a12
Ancestors: Tools-bf.439
Backported From: Tools-fbs.444

Stay in the debugger for longer. Part 4 of _5_.

Implement the Debugger side of things. Actually _remove_ the frame that signaled the NotImplemented from the call stack.

=============== Diff against Tools-bf.439 ===============

Item was changed:
  ----- Method: Debugger>>buildNotifierWith:label:message: (in category 'toolbuilder') -----
  buildNotifierWith: builder label: label message: messageString
  | windowSpec listSpec textSpec panelSpec quads |
  windowSpec := builder pluggableWindowSpec new.
  windowSpec model: self.
  windowSpec extent: 450 @ 156. "nice and wide to show plenty of the error msg"
  windowSpec label: label.
  windowSpec children: OrderedCollection new.
 
  panelSpec := builder pluggablePanelSpec new.
  panelSpec children: OrderedCollection new.
  quads := self preDebugButtonQuads.
+ (#(#notYetImplemented #shouldBeImplemented #doesNotUnderstand:) includes: self interruptedContext selector) ifTrue: [
- (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [
  quads := quads copyWith:
  { 'Create'. #createMethod. #magenta. 'create the missing method' }
  ].
+ (self interruptedContext selector == #subclassResponsibility) ifTrue: [
+ quads := quads copyWith:
+ { 'Create'. #createOverridingMethod. #magenta. 'create the missing overriding method' }
+ ].
  quads do:[:spec| | buttonSpec |
  buttonSpec := builder pluggableButtonSpec new.
  buttonSpec model: self.
  buttonSpec label: spec first.
  buttonSpec action: spec second.
  buttonSpec help: spec fourth.
  buttonSpec frame: self preDebugButtonQuadFrame.
  panelSpec children add: buttonSpec.
  ].
  panelSpec layout: #horizontal. "buttons"
  panelSpec frame: self preDebugButtonQuadFrame.
  windowSpec children add: panelSpec.
 
  Preferences eToyFriendly | messageString notNil ifFalse:[
  listSpec := builder pluggableListSpec new.
  listSpec
  model: self;
  list: #contextStackList;
  getIndex: #contextStackIndex;
  setIndex: #debugAt:;
  frame: self contextStackFrame.
  windowSpec children add: listSpec.
  ] ifTrue:[
  message := messageString.
  textSpec := builder pluggableTextSpec new.
  textSpec
  model: self;
  getText: #preDebugMessageString;
  setText: nil;
  selection: nil;
  menu: #debugProceedMenu:;
  frame: self contextStackFrame.
  windowSpec children add: textSpec.
  ].
 
  ^windowSpec!

Item was changed:
  ----- 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 |
+ msg := self contextStackTop exceptionMessage.
- msg := self contextStackTop tempAt: 1.
  chosenClass := self
  askForSuperclassOf: self contextStackTop receiver class
  toImplement: msg selector
  ifCancel: [^self].
+ self implement: msg inClass: chosenClass.!
- self implement: msg inClass: chosenClass.
- !

Item was added:
+ ----- 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 was
+ missing and proceed into it."
+ | msg |
+ msg := self contextStackTop exceptionMessage.
+ self implement: msg inClass: self contextStackTop receiver class inCategory: self contextStackTop selectorCategory.!

Item was changed:
  ----- Method: Debugger>>implement:inClass: (in category 'context stack menu') -----
  implement: aMessage inClass: aClass
+ ^ self
+ implement: aMessage
+ inClass: aClass
+ inCategory: (self askForCategoryIn: aClass default: 'as yet unclassified').!
-
- aClass
- compile: aMessage createStubMethod
- classified: (self askForCategoryIn: aClass default: 'as yet unclassified').
- self setContentsToForceRefetch.
- self selectedContext privRefreshWith: (aClass lookupSelector: aMessage selector).
- self selectedContext method numArgs > 0 ifTrue:
- [(self selectedContext tempAt: 1) arguments withIndexDo:
- [:arg :index|
- self selectedContext tempAt: index put: arg]].
- self resetContext: self selectedContext.
- self debug.
- !

Item was added:
+ ----- Method: Debugger>>implement:inClass:inCategory: (in category 'context stack menu') -----
+ implement: aMessage inClass: aClass inCategory: aSymbol
+ aClass
+ compile: aMessage createStubMethod
+ classified: aSymbol.
+ self setContentsToForceRefetch.
+ self selectedContext privRefreshWith: (aClass lookupSelector: aMessage selector).
+ aMessage numArgs > 0 ifTrue:
+ [aMessage arguments withIndexDo:
+ [:arg :index|
+ self selectedContext tempAt: index put: arg]].
+
+ "Snip out of the call stack the context that raised the debugger. - the #notYetImplemented send, for example."
+ self selectedContext privSender: self selectedContext sender sender.
+ self resetContext: self selectedContext.
+ self debug.!