diff -r 6c37ed85b725 -r 973b534176ca DebugView.st --- 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