--- a/DebugView.st Wed May 04 12:58:24 2016 +0200
+++ b/DebugView.st Wed May 04 12:59:39 2016 +0200
@@ -8314,21 +8314,22 @@
!DebugView methodsFor:'user interaction'!
checkIfCodeIsReallyModified
- |source|
+ |methodSource editorCode|
codeView modified ifFalse:[^ false].
- currentMethod isNil ifTrue:[
- ^ false
- ].
- source := currentMethod source.
- source notNil ifTrue:[
- source string = codeView contents string ifTrue:[
- ^ false
- ].
- (source string withTabsExpanded:8) = (codeView contents string withTabsExpanded:8) ifTrue:[
- ^ false
- ].
+ currentMethod isNil ifTrue:[^ false].
+
+ methodSource := currentMethod source.
+ methodSource notNil ifTrue:[
+ methodSource := methodSource string.
+ editorCode := codeView contents string.
+ methodSource = editorCode ifTrue:[
+ ^ false
+ ].
+ (methodSource withTabsExpanded:8) = (editorCode withTabsExpanded:8) ifTrue:[
+ ^ false
+ ].
].
^ true
!
@@ -8398,110 +8399,116 @@
|con newMethod|
codeView withWaitCursorDo:[
- "
- find the method-home context for this one
- "
- doUnwind ifTrue:[
- con := selectedContext.
- top := con.
- [con notNil] whileTrue:[
- (con methodHome == selectedContext) ifTrue:[
- top := con
- ].
- con := con sender
- ].
- ].
-
- "/
- "/ provide the classes nameSpace and changefile-update answers;
- "/ in case we accept while in another context, to not capture these settings again
- "/
- (Class updateChangeFileQuerySignal,
- Class updateChangeListQuerySignal,
- Class updateHistoryLineQuerySignal) answer:true
- do:[
- Class nameSpaceQuerySignal answer:(aClass nameSpace)
- do:[
- "/ the compiler nowadays already cares for the package...
- "/ no, actually, it does not in case we are in the middle of a fileIn,
- "/ and packageQuery is already answered by someone else.
- "/ Better make it unpackaged, in case the user makes changes to other
- "/ classes here (actually, I often change compiler, debugger, inspector here)
- Class packageQuerySignal
- answer:nil
- do:[
- codeView contents:someCode.
- Class methodRedefinitionNotification
- answer:#keep
- do:[
- | breakpoints |
-
- breakpoints := nil.
- codeView isCodeView2 ifTrue:[
- breakpoints := codeView breakpoints.
- ].
-
- BreakpointQuery answer: breakpoints do:[
- "/ Use original method's programming language instead of class's one.
- "/ In most cases it's the same, but it may be that the method edited
- "/ and accepted was an extension method written in another languages
- "/ (such as Smalltalk extension to Java class or Ruby extension to
- "/ Smalltalk class.
- newMethod := selectedContext programmingLanguage compilerClassForInteractiveTools
- compile:someCode
- forClass:aClass
- inCategory:category
- notifying:codeView.
- "/ Kludge for accepting Java code in a debugger. The Java compiler
- "/ does not compile single classes by always a full class and returns
- "/ the compiled class(es) rather than a method. However, we need to update
- "/ method holder of a codeView.
- "/
- "/ So, here we check whether the retuned `newMethod` is really a method,
- "/ if it's a class, try to search that class for a method with the
- "/ same selector as selector of currently selected context. If found,
- "/ thet's the 'new' method we are going to show.
- newMethod isBehavior ifTrue:[
- | selector |
-
- selector := selectedContext selector.
- newMethod := newMethod"actually a class" compiledMethodAt: selector ifAbsent: nil.
- ].
- ].
- ].
- ].
- ].
- ].
-
- methodCodeToggleSelectionHolder value:2. "/ showing current code
- methodCodeToggle beVisible.
-
- inspecting ifFalse:[
- (newMethod notNil and:[newMethod ~~ #Error]) ifTrue:[
- codeView modified:false.
- codeView isCodeView2 ifTrue:[
- codeView methodHolder value: newMethod.
- ].
-
- doUnwind ifTrue:[
- "/ if it worked, and doUnwind is true,
- "/ remove everything up to and including top
- "/ from the context chain
-
- selectedContext canReturn ifTrue:[
- self setContext:(top "sender").
- exitAction := #restart.
- selectedContext setLineNumber:1.
- self doRestart.
- ] ifFalse:[
- self setContext:(top sender).
- exitAction := #return.
- ].
- ].
- ] ifFalse:[
- ^ cancelAction value
- ]
- ].
+ "
+ find the method-home context for this one
+ "
+ doUnwind ifTrue:[
+ con := selectedContext.
+ top := con.
+ [con notNil] whileTrue:[
+ (con methodHome == selectedContext) ifTrue:[
+ top := con
+ ].
+ con := con sender
+ ].
+ ].
+
+ "/
+ "/ provide the classes nameSpace and changefile-update answers;
+ "/ in case we accept while in another context, to not capture these settings again
+ "/
+ (Class updateChangeFileQuerySignal,
+ Class updateChangeListQuerySignal,
+ Class updateHistoryLineQuerySignal) answer:true
+ do:[
+ Class nameSpaceQuerySignal answer:(aClass nameSpace)
+ do:[
+ "/ the compiler nowadays already cares for the package...
+ "/ no, actually, it does not in case we are in the middle of a fileIn,
+ "/ and packageQuery is already answered by someone else.
+ "/ Better make it unpackaged, in case the user makes changes to other
+ "/ classes here (actually, I often change compiler, debugger, inspector here)
+ Class packageQuerySignal
+ answer:nil
+ do:[
+ codeView contents:someCode.
+ Class methodRedefinitionNotification
+ answer:#keep
+ do:[
+ | breakpoints newMethodOrClass |
+
+ breakpoints := nil.
+ codeView isCodeView2 ifTrue:[
+ breakpoints := codeView breakpoints.
+ ].
+
+ BreakpointQuery answer: breakpoints do:[
+ "/ Use original method's programming language instead of class's one.
+ "/ In most cases it's the same, but it may be that the method edited
+ "/ and accepted was an extension method written in another languages
+ "/ (such as Smalltalk extension to Java class or Ruby extension to
+ "/ Smalltalk class.
+ newMethodOrClass := selectedContext programmingLanguage
+ compilerClassForInteractiveTools
+ compile:someCode
+ forClass:aClass
+ inCategory:category
+ notifying:codeView.
+ "/ Kludge for accepting Java code in a debugger. The Java compiler
+ "/ does not compile single methods but always a full class and returns
+ "/ the compiled class(es) rather than a method.
+ "/ However, we need to update the method holder of a codeView.
+ "/
+ "/ So, here we check whether the returned `newMethod` is really a method,
+ "/ if it's a class, try to search that class for a method with the
+ "/ same selector as selector of currently selected context. If found,
+ "/ that's the 'new' method we are going to show.
+ newMethodOrClass isBehavior ifTrue:[
+ | selector |
+
+ selector := selectedContext selector.
+ newMethod := newMethodOrClass compiledMethodAt: selector ifAbsent: nil.
+ ] ifFalse:[
+ newMethod := newMethodOrClass.
+ newMethod == #Error ifTrue:[
+ "/ should now be obsolete
+ newMethod := nil
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+
+ methodCodeToggleSelectionHolder value:2. "/ showing current code
+ methodCodeToggle beVisible.
+
+ inspecting ifFalse:[
+ (newMethod isNil) ifTrue:[^ cancelAction value].
+
+ codeView modified:false.
+ codeView isCodeView2 ifTrue:[
+ codeView methodHolder value: newMethod.
+ ].
+ currentMethod := newMethod.
+
+ doUnwind ifTrue:[
+ "/ if it worked, and doUnwind is true,
+ "/ remove everything up to and including top
+ "/ from the context chain
+
+ selectedContext canReturn ifTrue:[
+ self setContext:(top "sender").
+ exitAction := #restart.
+ selectedContext setLineNumber:1.
+ self doRestart.
+ ] ifFalse:[
+ self setContext:(top sender).
+ exitAction := #return.
+ ].
+ ].
+ ].
].
"Created: / 17-11-2001 / 21:50:55 / cg"
@@ -8847,407 +8854,408 @@
self setCurrentMethod:nil.
contextArray notNil ifTrue:[
- lineNr <= contextArray size ifTrue:[
- con := contextArray at:lineNr.
- callee := contextArray at:lineNr-1 ifAbsent:nil.
- ].
- "
- clicking on the '** ...'-line shows more ...
- "
- con isNil ifTrue:[
- line := contextView list at:lineNr.
- (line startsWith:'**') ifTrue:[
- self showMore.
- lineNr >= contextArray size ifTrue:[
- contextView setSelection:lineNr.
- con := contextArray at:lineNr ifAbsent:nil
- ]
- ].
- con isNil ifTrue:[
- codeView contents:nil.
- ^ self
- ].
- ].
-
- selectedContext := con.
- m := contextView middleButtonMenu.
- (m notNil and:[selectedContext notNil]) ifTrue:[
- m enableAll:#(browseImplementors browseSenders inspectContext)
- ].
-
- self withExecuteCursorDo:[
- codeSet := false.
-
- "
- give it to the (lower right) inspector
- "
- Error handle:[:ex |
- 'DebugView [warning]: error while accessing context: ' errorPrint.
- ex description errorPrintCR.
- contextInspector inspect:nil.
- contextInspector fieldListLabel:('Context').
- ex suspendedContext fullPrintAllOn: Transcript.
+ lineNr <= contextArray size ifTrue:[
+ con := contextArray at:lineNr.
+ callee := contextArray at:lineNr-1 ifAbsent:nil.
+ ].
+ "
+ clicking on the '** ...'-line shows more ...
+ "
+ con isNil ifTrue:[
+ line := contextView list at:lineNr.
+ (line startsWith:'**') ifTrue:[
+ self showMore.
+ lineNr >= contextArray size ifTrue:[
+ contextView setSelection:lineNr.
+ con := contextArray at:lineNr ifAbsent:nil
+ ]
+ ].
+ con isNil ifTrue:[
+ codeView contents:nil.
+ ^ self
+ ].
+ ].
+
+ selectedContext := con.
+ m := contextView middleButtonMenu.
+ (m notNil and:[selectedContext notNil]) ifTrue:[
+ m enableAll:#(browseImplementors browseSenders inspectContext)
+ ].
+
+ self withExecuteCursorDo:[
+ codeSet := false.
+
+ "
+ give it to the (lower right) inspector
+ "
+ Error handle:[:ex |
+ 'DebugView [warning]: error while accessing context: ' errorPrint.
+ ex description errorPrintCR.
+ contextInspector inspect:nil.
+ contextInspector fieldListLabel:('Context').
+ ex suspendedContext fullPrintAllOn: Transcript.
"/ ex reject.
- ] do:[
- contextInspector inspect:con.
- "/ contextInspector fieldListLabel:('Context: ',con method whoString).
- contextInspector tryToSelectKeyNamed:lastSelectionInContextInspector.
- ].
-
- "/ show a stack inspector sometimes
-
- con hasStackToShow ifTrue:[
- self showStackInspectorFor:con
- ] ifFalse:[
- self hideStackInspector
- ].
-
- homeContext := con methodHome.
- con canReturn ifTrue:[
- returnButton enable. restartButton enable.
- ] ifFalse:[
- returnButton disable. restartButton disable.
- ].
-
- lineNrInMethod := con lineNumber.
-
- canAccept := false.
-
- homeContext isNil ifTrue:[
- "
- mhmh - an optimized block
- should get the block here, and get the method from
- that one ...
- But in the current version, there is no easy way to get to the block
- since that one is not in the context.
- A future new block calling scheme will fix this
- (passing the block instead of the home as block argument).
- "
- (method := con method) isNil ifTrue:[
- "temporary kludge - peek into the sender context.
- If its a do-like method and there is a single block variable
- in the args or temporaries, that must be the one.
- This helps in some cases.
- "
- (sender := con sender) notNil ifTrue:[
- tryVars := false.
- (selSender := sender selector) notNil ifTrue:[
- ((selSender endsWith:'do:') or:[selSender endsWith:'Do:']) ifTrue:[
- tryVars := true.
- ]
- ].
- tryVars ifTrue:[
- possibleBlocks := sender argsAndVars select:[:v | v isBlock].
- possibleBlocks := possibleBlocks select:[:b | b home isNil].
- possibleBlocks size == 1 ifTrue:[
- method := possibleBlocks first method.
- ].
- ]
- ].
- ]
- ] ifFalse:[
- "fetch rec here - so we won't need context in doItAction"
- rec := homeContext receiver.
- sel := homeContext selector.
- sel notNil ifTrue:[
- canAccept := true.
-
- implementorClass := homeContext methodClass.
- implementorClass isNil ifTrue:[
- homeContext method notNil ifTrue:[
- WrappedMethod allInstancesDo:[:wrapped |
- wrapped originalMethod == homeContext method ifTrue:[
- implementorClass := wrapped mclass
- ]
- ].
- implementorClass isNil ifTrue:[
- (homeContext searchClass notNil
- and:[homeContext searchClass isObsolete]) ifTrue:[
- cannotAcceptDueToOutdatedClass := true.
- ]
- ].
- ].
- ].
- implementorClass isNil ifTrue:[
- Error handle:[:ex |
+ ] do:[
+ contextInspector inspect:con.
+ "/ contextInspector fieldListLabel:('Context: ',con method whoString).
+ contextInspector tryToSelectKeyNamed:lastSelectionInContextInspector.
+ ].
+
+ "/ show a stack inspector sometimes
+
+ con hasStackToShow ifTrue:[
+ self showStackInspectorFor:con
+ ] ifFalse:[
+ self hideStackInspector
+ ].
+
+ homeContext := con methodHome.
+ con canReturn ifTrue:[
+ returnButton enable. restartButton enable.
+ ] ifFalse:[
+ returnButton disable. restartButton disable.
+ ].
+
+ lineNrInMethod := con lineNumber.
+
+ canAccept := false.
+
+ homeContext isNil ifTrue:[
+ "
+ mhmh - an optimized block
+ should get the block here, and get the method from
+ that one ...
+ But in the current version, there is no easy way to get to the block
+ since that one is not in the context.
+ A future new block calling scheme will fix this
+ (passing the block instead of the home as block argument).
+ "
+ (method := con method) isNil ifTrue:[
+ "temporary kludge - peek into the sender context.
+ If its a do-like method and there is a single block variable
+ in the args or temporaries, that must be the one.
+ This helps in some cases.
+ "
+ (sender := con sender) notNil ifTrue:[
+ tryVars := false.
+ (selSender := sender selector) notNil ifTrue:[
+ ((selSender endsWith:'do:') or:[selSender endsWith:'Do:']) ifTrue:[
+ tryVars := true.
+ ]
+ ].
+ tryVars ifTrue:[
+ possibleBlocks := sender argsAndVars select:[:v | v isBlock].
+ possibleBlocks := possibleBlocks select:[:b | b home isNil].
+ possibleBlocks size == 1 ifTrue:[
+ method := possibleBlocks first method.
+ ].
+ ]
+ ].
+ ]
+ ] ifFalse:[
+ "fetch rec here - so we won't need context in doItAction"
+ rec := homeContext receiver.
+ sel := homeContext selector.
+ sel notNil ifTrue:[
+ canAccept := true.
+
+ implementorClass := homeContext methodClass.
+ implementorClass isNil ifTrue:[
+ homeContext method notNil ifTrue:[
+ WrappedMethod allInstancesDo:[:wrapped |
+ wrapped originalMethod == homeContext method ifTrue:[
+ implementorClass := wrapped mclass
+ ]
+ ].
+ implementorClass isNil ifTrue:[
+ (homeContext searchClass notNil
+ and:[homeContext searchClass isObsolete]) ifTrue:[
+ cannotAcceptDueToOutdatedClass := true.
+ ]
+ ].
+ ].
+ ].
+ implementorClass isNil ifTrue:[
+ Error handle:[:ex |
"/ not covered by Error, anyway
"/ ex signal == BreakPointInterrupt ifTrue:[
"/ ex proceed.
"/ ].
- code := 'error while asking method for its source'.
- code := code , Character cr , ex creator printString.
- code := code , Character cr , 'in: ' , ex suspendedContext printString.
-
- canAccept := false.
- ex return.
- ] do:[
- "
- special: look if this context was created by
- valueWithReceiver kind of method invocation;
- if so, grab the method from the sender and show it
- "
- ((sender := homeContext sender) notNil
- and:[((sender selector ? '') startsWith:'valueWithReceiver:')
- and:[sender receiver isMethod]]) ifTrue:[
- method := sender receiver.
- canAccept := false.
- ] ifFalse:[
- (method := con method) notNil ifTrue:[
- canAccept := false.
- ]
- ].
- ]
- ] ifFalse:[
- method := implementorClass compiledMethodAt:sel.
- ].
- ]
- ].
-
- homeContext notNil ifTrue:[
- searchClass := homeContext searchClass ? rec class.
- currentMethod := searchClass lookupMethodFor:sel.
- ].
- originalMethod := currentMethod.
- (currentMethod notNil
- and:[currentMethod ~~ method
- and:[ (currentMethod isWrapped and:[ method == currentMethod originalMethod]) not ]]) ifTrue:[
- originalMethod := method.
- methodCodeToggleSelectionHolder value = 1 ifTrue:[
- method := originalMethod. "/ the one which is suspended / was executing
- ] ifFalse:[
- method := currentMethod. "/ the one which has already been accepted/modified.
- lineNrInMethod := nil.
- canAccept := true.
- ].
- methodCodeToggle beVisible.
- ] ifFalse:[
- methodCodeToggle beInvisible.
- ].
-
- code isNil ifTrue:[
- errMsg := nil.
- method isNil ifTrue:[
- "/ fall back heuristics (see how this was called, fetch block from caller)
- sender := con sender.
- con isBlockContext ifTrue:[
- (sender notNil
- and:[((sender selector ? '') startsWith:'value')
- and:[sender receiver isBlock]]) ifTrue:[
- code := sender receiver source.
- ]
- ] ifFalse:[
- (sender notNil
- and:[((sender selector ? '') startsWith:'valueWith')
- and:[sender receiver isMethod]]) ifTrue:[
- method := sender receiver.
- ]
- ]
- ].
- method notNil ifTrue:[
- contextInspector fieldListLabel:(method selector "whoString").
- Error handle:[:ex |
+ code := 'error while asking method for its source'.
+ code := code , Character cr , ex creator printString.
+ code := code , Character cr , 'in: ' , ex suspendedContext printString.
+
+ canAccept := false.
+ ex return.
+ ] do:[
+ "
+ special: look if this context was created by
+ valueWithReceiver kind of method invocation;
+ if so, grab the method from the sender and show it
+ "
+ ((sender := homeContext sender) notNil
+ and:[((sender selector ? '') startsWith:'valueWithReceiver:')
+ and:[sender receiver isMethod]]) ifTrue:[
+ method := sender receiver.
+ canAccept := false.
+ ] ifFalse:[
+ (method := con method) notNil ifTrue:[
+ canAccept := false.
+ ]
+ ].
+ ]
+ ] ifFalse:[
+ method := implementorClass compiledMethodAt:sel.
+ ].
+ ]
+ ].
+
+ homeContext notNil ifTrue:[
+ searchClass := homeContext searchClass ? rec class.
+ currentMethod := searchClass lookupMethodFor:sel.
+ ].
+ originalMethod := currentMethod.
+ (currentMethod notNil
+ and:[currentMethod ~~ method
+ and:[ (currentMethod isWrapped and:[ method == currentMethod originalMethod]) not ]]
+ ) ifTrue:[
+ originalMethod := method.
+ methodCodeToggleSelectionHolder value = 1 ifTrue:[
+ method := originalMethod. "/ the one which is suspended / was executing
+ ] ifFalse:[
+ method := currentMethod. "/ the one which has already been accepted/modified.
+ lineNrInMethod := nil.
+ canAccept := true.
+ ].
+ methodCodeToggle beVisible.
+ ] ifFalse:[
+ methodCodeToggle beInvisible.
+ ].
+
+ code isNil ifTrue:[
+ errMsg := nil.
+ method isNil ifTrue:[
+ "/ fall back heuristics (see how this was called, fetch block from caller)
+ sender := con sender.
+ con isBlockContext ifTrue:[
+ (sender notNil
+ and:[((sender selector ? '') startsWith:'value')
+ and:[sender receiver isBlock]]) ifTrue:[
+ code := sender receiver source.
+ ]
+ ] ifFalse:[
+ (sender notNil
+ and:[((sender selector ? '') startsWith:'valueWith')
+ and:[sender receiver isMethod]]) ifTrue:[
+ method := sender receiver.
+ ]
+ ]
+ ].
+ method notNil ifTrue:[
+ contextInspector fieldListLabel:(method selector "whoString").
+ Error handle:[:ex |
"/ not covered by Error, anyway
"/ ex signal isControlInterrupt ifTrue:[
"/ ex proceed.
"/ ].
- code := 'error while asking method for its source'.
- code := code , Character cr , ex creator printString.
- code := code , Character cr , 'in: ' , ex suspendedContext printString.
-
- canAccept := false.
- ex return.
- ] do:[
- self sensor shiftDown ifTrue:[
- code := method decompiledSource
- ] ifFalse:[
- code := method source.
- ].
- ].
-
- code isNil ifTrue:[
- method sourceFilename notNil ifTrue:[
- codeView contents:(resources
- string:'** no sourcefile: %1 **'
- with:method sourceFilename).
- codeView realized ifTrue:[
- "codeView is not realized on initial startup"
- codeView flash:'no source'.
- ].
- codeSet := true.
- ] ifFalse:[
- [
- |src|
-
- src := String streamContents:[:s | Decompiler decompile:method to:s].
- codeView contents:src.
- codeSet := true.
- ] on: Error do:[
- errMsg := '** no source **'
- ].
- ]
- ].
- ] ifFalse:[
- contextInspector fieldListLabel:'Context'.
- homeContext isNil ifTrue:[
- errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'.
- ] ifFalse:[
- errMsg := '** no method - no source **'.
- canDefine := false. "/ true.
- ]
- ].
- errMsg notNil ifTrue:[
- self showError:errMsg.
- codeSet := true.
- ]
- ].
-
- code isNil ifTrue:[
- "/ canAccept := false.
- codeSet ifFalse:[
- codeView contents:nil.
- ]
- ] ifFalse:[
- lineNrInMethod notNil ifTrue:[
- lineNrInMethod == 0 ifTrue:[
- (method notNil and:[method isJavaMethod]) ifTrue:[
- lineNrInMethod := method lineNumber
- ].
- "/ guess lineNumber from sent-messages selector
- "/ kludge to fix lineNr-display of shared subclassResponsibility methods.
- lineNrInMethod == 0 ifTrue:[
- |conIdx sentContext messages|
-
- conIdx := contextArray identityIndexOf:con.
- conIdx > 1 ifTrue:[
- sentContext := contextArray at:conIdx-1.
- sentContext isBlockContext ifFalse:[
- (method notNil and:[code notNil]) ifTrue:[
- messages := method messagesSent.
- messages size == 1 ifTrue:[
- sentContext selector == messages first ifTrue:[
- lineNrInMethod := code asStringCollection findFirst:[:l | l includesString:sentContext selector].
- ]
- ]
- ].
- ].
- ].
- ].
- ].
- ].
- codeView isCodeView2 ifTrue:[
- codeView model
- setValue: code;
- changed.
- codeView methodHolder value: method.
- codeView classHolder value: ((method respondsTo: #mclass) ifTrue:[method mclass] ifFalse:[rec class])
- ] ifFalse:[
- UserPreferences current syntaxColoring ifTrue:[
- implementorClass isNil ifTrue:[
- (con isBlockContext
- and:[con home isNil
- and:[con guessedHome notNil]])
- ifTrue:[
- implementorClass := con guessedHome mclass
- ]
- ].
- implementorClass notNil ifTrue:[
- (highlighter := implementorClass syntaxHighlighterClass) notNil ifTrue:[
- code size < 100000 ifTrue:[
- Error catch:[
- code := highlighter formatMethodSource:code in:implementorClass.
- ]
- ]
- ]
- ]
- ].
+ code := 'error while asking method for its source'.
+ code := code , Character cr , ex creator printString.
+ code := code , Character cr , 'in: ' , ex suspendedContext printString.
+
+ canAccept := false.
+ ex return.
+ ] do:[
+ self sensor shiftDown ifTrue:[
+ code := method decompiledSource
+ ] ifFalse:[
+ code := method source.
+ ].
+ ].
+
+ code isNil ifTrue:[
+ method sourceFilename notNil ifTrue:[
+ codeView contents:(resources
+ string:'** no sourcefile: %1 **'
+ with:method sourceFilename).
+ codeView realized ifTrue:[
+ "codeView is not realized on initial startup"
+ codeView flash:'no source'.
+ ].
+ codeSet := true.
+ ] ifFalse:[
+ [
+ |src|
+
+ src := String streamContents:[:s | Decompiler decompile:method to:s].
+ codeView contents:src.
+ codeSet := true.
+ ] on: Error do:[
+ errMsg := '** no source **'
+ ].
+ ]
+ ].
+ ] ifFalse:[
+ contextInspector fieldListLabel:'Context'.
+ homeContext isNil ifTrue:[
+ errMsg := '** sorry; cannot show code of all optimized blocks (yet) **'.
+ ] ifFalse:[
+ errMsg := '** no method - no source **'.
+ canDefine := false. "/ true.
+ ]
+ ].
+ errMsg notNil ifTrue:[
+ self showError:errMsg.
+ codeSet := true.
+ ]
+ ].
+
+ code isNil ifTrue:[
+ "/ canAccept := false.
+ codeSet ifFalse:[
+ codeView contents:nil.
+ ]
+ ] ifFalse:[
+ lineNrInMethod notNil ifTrue:[
+ lineNrInMethod == 0 ifTrue:[
+ (method notNil and:[method isJavaMethod]) ifTrue:[
+ lineNrInMethod := method lineNumber
+ ].
+ "/ guess lineNumber from sent-messages selector
+ "/ kludge to fix lineNr-display of shared subclassResponsibility methods.
+ lineNrInMethod == 0 ifTrue:[
+ |conIdx sentContext messages|
+
+ conIdx := contextArray identityIndexOf:con.
+ conIdx > 1 ifTrue:[
+ sentContext := contextArray at:conIdx-1.
+ sentContext isBlockContext ifFalse:[
+ (method notNil and:[code notNil]) ifTrue:[
+ messages := method messagesSent.
+ messages size == 1 ifTrue:[
+ sentContext selector == messages first ifTrue:[
+ lineNrInMethod := code asStringCollection findFirst:[:l | l includesString:sentContext selector].
+ ]
+ ]
+ ].
+ ].
+ ].
+ ].
+ ].
+ ].
+ codeView isCodeView2 ifTrue:[
+ codeView model
+ setValue: code;
+ changed.
+ codeView methodHolder value: method.
+ codeView classHolder value: ((method respondsTo: #mclass) ifTrue:[method mclass] ifFalse:[rec class])
+ ] ifFalse:[
+ UserPreferences current syntaxColoring ifTrue:[
+ implementorClass isNil ifTrue:[
+ (con isBlockContext
+ and:[con home isNil
+ and:[con guessedHome notNil]])
+ ifTrue:[
+ implementorClass := con guessedHome mclass
+ ]
+ ].
+ implementorClass notNil ifTrue:[
+ (highlighter := implementorClass syntaxHighlighterClass) notNil ifTrue:[
+ code size < 100000 ifTrue:[
+ Error catch:[
+ code := highlighter formatMethodSource:code in:implementorClass.
+ ]
+ ]
+ ]
+ ]
+ ].
"/ code ~= (codeView contents) ifTrue:[
- cannotAcceptDueToOutdatedClass ifTrue:[
- codeView setContents:(('Obsolete code (outdated due to class change). Use Browser.' colorizeAllWith:Color red),Character cr,Character cr,code asString).
- ] ifFalse:[
- codeView setContents:code.
- ].
+ cannotAcceptDueToOutdatedClass ifTrue:[
+ codeView setContents:(('Obsolete code (outdated due to class change). Use Browser.' colorizeAllWith:Color red),Character cr,Character cr,code asString).
+ ] ifFalse:[
+ codeView setContents:code.
+ ].
"/ ].
- ].
- (lineNrInMethod notNil
- and:[lineNrInMethod ~~ 0
- and:[lineNrInMethod <= codeView list size]]) ifTrue:[
+ ].
+ (lineNrInMethod notNil
+ and:[lineNrInMethod ~~ 0
+ and:[lineNrInMethod <= codeView list size]]) ifTrue:[
lineNrInMethod == 255 ifFalse:[
- (lineNrInMethod == 255
- and:[method notNil
- and:[method hasCode not]]) ifTrue:[
- "/ means: do not really know in interpreted methods
- codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0.
- ] ifFalse:[
- codeView selectLine:lineNrInMethod.
- ].
- codeView makeSelectionVisible
+ (lineNrInMethod == 255
+ and:[method notNil
+ and:[method hasCode not]]) ifTrue:[
+ "/ means: do not really know in interpreted methods
+ codeView selectFromLine:255 col:1 toLine:codeView list size + 1 col:0.
+ ] ifFalse:[
+ codeView selectLine:lineNrInMethod.
+ ].
+ codeView makeSelectionVisible
].
- ] ifFalse:[
- codeView unselect.
- codeView scrollToTop
- ]
- ].
-
- codeView acceptEnabled:canAccept.
- canAccept ifTrue:[
- codeView acceptAction:[:code | self codeAccept:code asString]
- ] ifFalse:[
- codeView acceptAction:[:code | self beep]
- ].
-
- receiverInspector inspect:rec.
- receiverInspector fieldListLabel:("'Receiver: ',"rec classNameWithArticle).
- receiverInspector tryToSelectKeyNamed:lastSelectionInReceiverInspector.
-
- "
- the one below is wrong: currently, the
- evaluator cannot handle passed contexts.
- Once it does, pass con as in:-arg
- "
- (rec isJavaObject
- and:[method isNil or:[method isJavaMethod not]]) ifTrue:[
- "/ although a java object, use the smalltalk parser here for doIts.
- evaluatorClass := Parser.
- codeView commentStrings:#( '//' ( '/*' '*/' ) ).
- ] ifFalse:[
- (method notNil and:[method mclass notNil]) ifTrue:[
- evaluatorClass := method mclass evaluatorClass.
- codeView commentStrings:method mclass programmingLanguage commentStrings.
- ] ifFalse:[
- evaluatorClass := rec class evaluatorClass.
- codeView commentStrings:rec class programmingLanguage commentStrings.
- ].
- ].
-
- codeView
- doItAction:
- [:theCode |
- evaluatorClass
- evaluate:theCode
- in:actualContext "/ (selectedContext ? actualContext)
- receiver:rec
- notifying:codeView
- logged:true
- ifFail:nil
- ];
- editedMethodOrClass:(method ? rec class).
-
-
- self setCurrentMethod:method.
-
- selectedContext := homeContext ? con.
- actualContext := con
- ].
+ ] ifFalse:[
+ codeView unselect.
+ codeView scrollToTop
+ ]
+ ].
+
+ codeView acceptEnabled:canAccept.
+ canAccept ifTrue:[
+ codeView acceptAction:[:code | self codeAccept:code asString]
+ ] ifFalse:[
+ codeView acceptAction:[:code | self beep]
+ ].
+
+ receiverInspector inspect:rec.
+ receiverInspector fieldListLabel:("'Receiver: ',"rec classNameWithArticle).
+ receiverInspector tryToSelectKeyNamed:lastSelectionInReceiverInspector.
+
+ "
+ the one below is wrong: currently, the
+ evaluator cannot handle passed contexts.
+ Once it does, pass con as in:-arg
+ "
+ (rec isJavaObject
+ and:[method isNil or:[method isJavaMethod not]]) ifTrue:[
+ "/ although a java object, use the smalltalk parser here for doIts.
+ evaluatorClass := Parser.
+ codeView commentStrings:#( '//' ( '/*' '*/' ) ).
+ ] ifFalse:[
+ (method notNil and:[method mclass notNil]) ifTrue:[
+ evaluatorClass := method mclass evaluatorClass.
+ codeView commentStrings:method mclass programmingLanguage commentStrings.
+ ] ifFalse:[
+ evaluatorClass := rec class evaluatorClass.
+ codeView commentStrings:rec class programmingLanguage commentStrings.
+ ].
+ ].
+
+ codeView
+ doItAction:
+ [:theCode |
+ evaluatorClass
+ evaluate:theCode
+ in:actualContext "/ (selectedContext ? actualContext)
+ receiver:rec
+ notifying:codeView
+ logged:true
+ ifFail:nil
+ ];
+ editedMethodOrClass:(method ? rec class).
+
+
+ self setCurrentMethod:method.
+
+ selectedContext := homeContext ? con.
+ actualContext := con
+ ].
] ifFalse:[
- codeView contents:nil.
+ codeView contents:nil.
].
codeView modified:false.
con isContext ifFalse:[
- sendButton disable.
+ sendButton disable.
] ifTrue:[
- sendButton enable.
+ sendButton enable.
].
self updateContextInfoFor:con.
@@ -9260,9 +9268,9 @@
homeContext := nil.
(canDefine or:[self canDefineForCallee:callee]) ifTrue:[
- defineButton beVisible.
+ defineButton beVisible.
] ifFalse:[
- defineButton beInvisible.
+ defineButton beInvisible.
].
"/ enable/disable some menu items