DebugView.st
changeset 17372 902487791641
parent 17305 862a23b67f68
child 17398 0d92218ed77b
equal deleted inserted replaced
17371:ffbfab2b0c09 17372:902487791641
     1 "{ Encoding: utf8 }"
       
     2 
       
     3 "
     1 "
     4  COPYRIGHT (c) 1989 by Claus Gittinger
     2  COPYRIGHT (c) 1989 by Claus Gittinger
     5               All Rights Reserved
     3               All Rights Reserved
     6 
     4 
     7  This software is furnished under a license and may be used
     5  This software is furnished under a license and may be used
  1473          (MenuItem
  1471          (MenuItem
  1474             enabled: canDefineMethod
  1472             enabled: canDefineMethod
  1475             label: 'Define Missing Method'
  1473             label: 'Define Missing Method'
  1476             itemValue: doDefineMethod
  1474             itemValue: doDefineMethod
  1477           )
  1475           )
       
  1476          (MenuItem
       
  1477             enabled: canRedefineMethodInReceiverClass
       
  1478             label: 'Redefine Method in Receiver Class'
       
  1479             itemValue: doRedefineMethodInReceiverClass  
       
  1480           )
  1478          )
  1481          )
  1479         nil
  1482         nil
  1480         nil
  1483         nil
  1481       )
  1484       )
       
  1485 
       
  1486     "Modified: / 08-02-2017 / 08:46:50 / cg"
  1482 !
  1487 !
  1483 
  1488 
  1484 viewMenuSpec
  1489 viewMenuSpec
  1485     "This resource specification was automatically generated
  1490     "This resource specification was automatically generated
  1486      by the MenuEditor of ST/X."
  1491      by the MenuEditor of ST/X."
  5090     Delay waitForSeconds:5.
  5095     Delay waitForSeconds:5.
  5091     self doContinue.
  5096     self doContinue.
  5092 !
  5097 !
  5093 
  5098 
  5094 doDefine
  5099 doDefine
  5095     |selectionIndex selector argNames receiversClass proto haltStmtDef haltStmtFix code cat
  5100     "when we hit an unimplemented message, the define button becomes visible.
  5096      bagOfClassNames bagOfUsedClassNames implClass idx callee restart varName argName|
  5101      This is the action of it, when clicked.
       
  5102      Define a new halting method in the faulting class,
       
  5103      and restart the context so we end up in the halt of the new method"
       
  5104      
       
  5105     |selectionIndex selector argNames receiversClass proto haltStmtDef haltStmtFix code cat implClass idx callee restart varName argName|
  5097 
  5106 
  5098     selectionIndex := contextView selection.
  5107     selectionIndex := contextView selection.
  5099     restart := true.
  5108     restart := true.
  5100 
  5109 
  5101     selectorToDefine notNil ifTrue:[
  5110     selectorToDefine notNil ifTrue:[
  5119             ]
  5128             ]
  5120         ].
  5129         ].
  5121     ].
  5130     ].
  5122 
  5131 
  5123     "generate nice argument names"
  5132     "generate nice argument names"
  5124     bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag.
  5133     argNames := self argumentNamesForNewMethodOfContext:actualContext.
  5125     bagOfUsedClassNames := Bag new.
       
  5126     argNames := actualContext args
       
  5127                     collect:
       
  5128                         [:eachArg |
       
  5129                             |nm|
       
  5130 
       
  5131                             nm := eachArg class nameWithoutPrefix.
       
  5132                             (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[
       
  5133                                 nm article , nm
       
  5134                             ] ifFalse:[
       
  5135                                 bagOfUsedClassNames add:nm.
       
  5136                                 nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString
       
  5137                             ].
       
  5138                         ].
       
  5139 
       
  5140     proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames.
  5134     proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames.
  5141 
  5135 
  5142     haltStmtDef := '    self halt:''please define %2 here''.'.
  5136     haltStmtDef := '    self halt:''please define %2 here''.'.
  5143     haltStmtFix := '    self halt:''please change %2 as required''.'.
  5137     haltStmtFix := '    self halt:''please change %2 as required''.'.
  5144 
  5138 
  5203     self doShowSelection:selectionIndex.
  5197     self doShowSelection:selectionIndex.
  5204     restart ifTrue:[
  5198     restart ifTrue:[
  5205         self doRestart
  5199         self doRestart
  5206     ]
  5200     ]
  5207 
  5201 
  5208     "Modified: / 23-03-2012 / 09:49:31 / cg"
  5202     "Modified: / 08-02-2017 / 08:58:50 / cg"
  5209 !
  5203 !
  5210 
  5204 
  5211 doGotoApplicationActionMethod
  5205 doGotoApplicationActionMethod
  5212     "select the first application-model context.
  5206     "select the first application-model context.
  5213      This is another great helper, when you hit an exception,
  5207      This is another great helper, when you hit an exception,
  5409         preOpenBlock:[:inst|
  5403         preOpenBlock:[:inst|
  5410             inst recipientEntryField value:'error@exept.de'
  5404             inst recipientEntryField value:'error@exept.de'
  5411         ].
  5405         ].
  5412 
  5406 
  5413     "Modified: / 20-09-2007 / 12:40:40 / cg"
  5407     "Modified: / 20-09-2007 / 12:40:40 / cg"
       
  5408 !
       
  5409 
       
  5410 doRedefineMethodInReceiverClass
       
  5411     |con selectionIndex argNames proto receiverClass implClass implMethod selector code cat|
       
  5412     
       
  5413     (con := actualContext) notNil ifTrue:[
       
  5414         selectionIndex := contextView selection.
       
  5415         
       
  5416         (actualContext home) notNil ifTrue:[
       
  5417             con := actualContext home 
       
  5418         ].
       
  5419         selector := con selector.
       
  5420         receiverClass := con receiver class.
       
  5421         (receiverClass implements:selector) ifFalse:[
       
  5422             implClass := receiverClass whichClassIncludesSelector:selector.
       
  5423             implMethod := implClass compiledMethodAt:selector.
       
  5424             
       
  5425             argNames := self argumentNamesForNewMethodOfContext:con.
       
  5426             proto := Method methodDefinitionTemplateForSelector:selector andArgumentNames:argNames.
       
  5427 
       
  5428             code := '%1\    self halt:''please redefine %2 here''.\    ^ super %1'.
       
  5429             cat := implMethod category.
       
  5430             
       
  5431             self
       
  5432                 codeAccept:(code bindWith:proto with:selector) withCRs
       
  5433                 inClass:receiverClass
       
  5434                 unwind:false
       
  5435                 category:cat
       
  5436                 onCancel:[^ self].
       
  5437 
       
  5438             self doShowSelection:selectionIndex.
       
  5439             self doRestart
       
  5440         ].
       
  5441     ].
       
  5442 
       
  5443     "Created: / 08-02-2017 / 09:07:25 / cg"
  5414 !
  5444 !
  5415 
  5445 
  5416 doResend
  5446 doResend
  5417     "resend - the selected context is unwound and its message resent.
  5447     "resend - the selected context is unwound and its message resent.
  5418      To be done after a cde change, to get nto the new method"
  5448      To be done after a cde change, to get nto the new method"
  7216     ]
  7246     ]
  7217 
  7247 
  7218     "Modified: / 25-11-2016 / 13:17:20 / cg"
  7248     "Modified: / 25-11-2016 / 13:17:20 / cg"
  7219 !
  7249 !
  7220 
  7250 
       
  7251 canRedefineMethodInReceiverClass
       
  7252     "true if a context is selected, where an inherited method was called.
       
  7253      Used to enable the redefine menu option"
       
  7254      
       
  7255     |con selector receiverClass implClass|
       
  7256     
       
  7257     (con := actualContext) notNil ifTrue:[
       
  7258         (actualContext home) notNil ifTrue:[
       
  7259             con := actualContext home 
       
  7260         ].
       
  7261         selector := con selector.
       
  7262         receiverClass := con receiver class.
       
  7263         (receiverClass implements:selector) ifFalse:[
       
  7264             implClass := receiverClass whichClassIncludesSelector:selector.
       
  7265             ^ implClass notNil
       
  7266         ].    
       
  7267     ].    
       
  7268     ^ false
       
  7269 
       
  7270     "Created: / 08-02-2017 / 08:45:38 / cg"
       
  7271 !
       
  7272 
  7221 canRestart
  7273 canRestart
  7222     ^ restartButton isEnabled
  7274     ^ restartButton isEnabled
  7223 
  7275 
  7224     "Modified: / 17.11.2001 / 19:59:49 / cg"
  7276     "Modified: / 17.11.2001 / 19:59:49 / cg"
  7225 !
  7277 !
  7458     OpenDebuggers notNil ifTrue:[
  7510     OpenDebuggers notNil ifTrue:[
  7459         OpenDebuggers remove:self ifAbsent:[].
  7511         OpenDebuggers remove:self ifAbsent:[].
  7460     ].
  7512     ].
  7461 
  7513 
  7462     "Modified: 31.7.1997 / 21:20:11 / cg"
  7514     "Modified: 31.7.1997 / 21:20:11 / cg"
       
  7515 ! !
       
  7516 
       
  7517 !DebugView methodsFor:'private-code generation helpers'!
       
  7518 
       
  7519 argumentNamesForNewMethodOfContext:context
       
  7520     "generate argument names for a prototypeMethod for the message in context.
       
  7521      Used by doDefine and doRedefine"
       
  7522 
       
  7523     |bagOfClassNames bagOfUsedClassNames argNames|
       
  7524     
       
  7525     bagOfClassNames := (actualContext args collect:[:eachArg | eachArg class name]) asBag.
       
  7526     bagOfUsedClassNames := Bag new.
       
  7527     argNames := actualContext args
       
  7528                     collect:
       
  7529                         [:eachArg |
       
  7530                             |nm|
       
  7531 
       
  7532                             nm := eachArg class nameWithoutPrefix.
       
  7533                             (bagOfClassNames occurrencesOf:nm) == 1 ifTrue:[
       
  7534                                 nm article , nm
       
  7535                             ] ifFalse:[
       
  7536                                 bagOfUsedClassNames add:nm.
       
  7537                                 nm asLowercaseFirst , (bagOfUsedClassNames occurrencesOf:nm) printString
       
  7538                             ].
       
  7539                         ].
       
  7540     ^ argNames
       
  7541 
       
  7542     "Created: / 08-02-2017 / 08:57:24 / cg"
  7463 ! !
  7543 ! !
  7464 
  7544 
  7465 !DebugView methodsFor:'private-code view'!
  7545 !DebugView methodsFor:'private-code view'!
  7466 
  7546 
  7467 codeAspect
  7547 codeAspect
  9562 
  9642 
  9563 !DebugView::IgnoredHaltOrBreakpoint methodsFor:'printing'!
  9643 !DebugView::IgnoredHaltOrBreakpoint methodsFor:'printing'!
  9564 
  9644 
  9565 printConditionOn:aStream
  9645 printConditionOn:aStream
  9566     ignoredSendingClassAndSelectors notEmptyOrNil ifTrue:[
  9646     ignoredSendingClassAndSelectors notEmptyOrNil ifTrue:[
  9567         aStream nextPutAll:(' if called from %1 » %2'
  9647         aStream nextPutAll:(' if called from %1 » %2'
  9568                                 bindWith:ignoredSendingClassAndSelectors first first
  9648                                 bindWith:ignoredSendingClassAndSelectors first first
  9569                                 with:ignoredSendingClassAndSelectors first second).
  9649                                 with:ignoredSendingClassAndSelectors first second).
  9570         ^ self.
  9650         ^ self.
  9571     ].
  9651     ].
  9572     ignoredProcesses notEmptyOrNil ifTrue:[
  9652     ignoredProcesses notEmptyOrNil ifTrue:[