Frank Shearar uploaded a new version of Tools to project The Inbox: http://source.squeak.org/inbox/Tools-fbs.461.mcz
==================== Summary ====================
Name: Tools-fbs.461 Author: fbs Time: 30 April 2013, 9:46:27.007 am UUID: 6b338c44-87ea-4b4a-9059-833bcd2545ed Ancestors: Tools-fbs.460
Clean up the "JIT development" flow. On hitting the "create" button in response to a MessageNotUnderstood, NotYetImplemented or SubclassResponsibility, * a MNU prompts the user for a class and category, pushes a stub method onto the call stack and debugs it; * a NYI debugs the context with the #notYetImplemented/#shouldBeImplemented; * a SR prompts the user for a class (between and including the receiver class and the superclass whose method has the #subclassResponsibility), categorises the new method the same as the superclass's, pushes a stub onto the call stack and debugs that stub.
In all cases, resumption lets methods _return_ values down the stack.
=============== Diff against Tools-fbs.460 ===============
Item was added: + ----- 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>>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. + (self interruptedContext selector == #doesNotUnderstand:) ifTrue: [ - (#(#notYetImplemented #shouldBeImplemented #doesNotUnderstand:) includes: self interruptedContext selector) ifTrue: [ quads := quads copyWith: { 'Create'. #createMethod. #magenta. 'create the missing method' } ]. + (#(#notYetImplemented #shouldBeImplemented) includes: self interruptedContext selector) ifTrue: [ + quads := quads copyWith: + { 'Create'. #createImplementingMethod. #magenta. 'implement the marked 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>>contents:notifying: (in category 'accessing') ----- contents: aText notifying: aController "The retrieved information has changed and its source must now be updated. In this case, the retrieved information is the method of the selected context." | result selector classOfMethod category h ctxt newMethod | contextStackIndex = 0 ifTrue: [^false]. self selectedContext isExecutingBlock ifTrue: [h := self selectedContext activeHome. h ifNil: [self inform: 'Method for block not found on stack, can''t edit and continue'. ^false]. (self confirm: 'I will have to revert to the method from\which this block originated. Is that OK?' withCRs) ifFalse: [^false]. self resetContext: h changeContents: false. "N.B. Only reset the contents if the compilation succeeds. If contents are reset when compilation fails both compiler error message and modifications are lost." (result := self contents: aText notifying: aController) ifTrue: [self contentsChanged]. ^result].
classOfMethod := self selectedClass. category := self selectedMessageCategoryName. selector := self selectedClass newParser parseSelector: aText. (selector == self selectedMessageName or: [(self selectedMessageName beginsWith: 'DoIt') and: [selector numArgs = self selectedMessageName numArgs]]) ifFalse: [self inform: 'can''t change selector'. ^false]. selector := classOfMethod compile: aText classified: category notifying: aController. selector ifNil: [^false]. "compile cancelled" contents := aText. newMethod := classOfMethod compiledMethodAt: selector. newMethod isQuick ifTrue: [self down. self selectedContext jump: (self selectedContext previousPc - self selectedContext pc)]. ctxt := interruptedProcess popTo: self selectedContext. ctxt == self selectedContext ifFalse: [self inform: 'Method saved, but current context unchanged\because of unwind error. Click OK to see error' withCRs] ifTrue: [newMethod isQuick ifFalse: [interruptedProcess restartTopWith: newMethod; stepToSendOrReturn]. contextVariablesInspector object: nil]. self resetContext: ctxt. Smalltalk isMorphic ifTrue: [World addAlarm: #changed: withArguments: #(contentsSelection) for: self at: (Time millisecondClockValue + 200)]. ^true!
Item was added: + ----- 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 | + signallingContext := self selectedContext sender. + "Pop the signalling context off the stack" + self resetContext: signallingContext. + self debug.!
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. chosenClass := self askForSuperclassOf: self contextStackTop receiver class toImplement: msg selector ifCancel: [^self]. + self implementMissingMethod: msg inClass: chosenClass.! - self implement: msg inClass: chosenClass.!
Item was changed: ----- 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 | - SubclassResponsibility exception. Create a stub for the method that was - missing and proceed into it." - | msg | 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.! - self implement: msg inClass: self contextStackTop receiver class inCategory: self contextStackTop selectorCategory.!
Item was removed: - ----- 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').!
Item was removed: - ----- 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.!
Item was added: + ----- 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 added: + ----- 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 added: + ----- 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>>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 add: each name target: self selector: #implement:inClass: argumentList: (Array with: msg with: each)]. ^ aMenu
!
Item was added: + ----- Method: Debugger>>pushStubMethodOnStack:inClass:inCategory: (in category 'private') ----- + pushStubMethodOnStack: aMessage inClass: aClass inCategory: aSymbol + "Create a stub implementation of the message and sew it onto the top of the stack, ensuring the context's arguments are set correctly." + 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]].!
Item was added: + ----- Method: PreDebugWindow>>createImplementingMethod (in category '*Tools-Debugger') ----- + createImplementingMethod + model createImplementingMethod.!
Item was added: + ----- Method: PreDebugWindow>>createMethod (in category '*Tools-Debugger') ----- + createMethod + model createMethod!
Item was added: + ----- Method: PreDebugWindow>>createOverridingMethod (in category '*Tools-Debugger') ----- + createOverridingMethod + model createOverridingMethod!