DebugView.st
changeset 14695 cecbcb8523d9
parent 14680 858e67cc7b81
child 14697 67aff7d828d2
equal deleted inserted replaced
14694:31166504525d 14695:cecbcb8523d9
    36 	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
    36 	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
    37 		DebuggingDebugger DebuggingDebugger2
    37 		DebuggingDebugger DebuggingDebugger2
    38 		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts
    38 		DefaultDebuggerBackgroundColor InitialNChainShown IgnoredHalts
    39 		ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration
    39 		ShowThreadID LastIgnoreHaltNTimes LastIgnoreHaltDuration
    40 		LastExtent LastOrigin RememberedCallChain DebuggingDebugger3
    40 		LastExtent LastOrigin RememberedCallChain DebuggingDebugger3
    41 		NumberOfDebuggers'
    41 		NumberOfDebuggers DebuggerOnMainDisplayOnly'
    42 	poolDictionaries:''
    42 	poolDictionaries:''
    43 	category:'Interface-Debugger'
    43 	category:'Interface-Debugger'
    44 !
    44 !
    45 
    45 
    46 Object subclass:#IgnoredHaltOrBreakpoint
    46 Object subclass:#IgnoredHaltOrBreakpoint
   186      DebugView newDebugger
   186      DebugView newDebugger
   187     "
   187     "
   188 ! !
   188 ! !
   189 
   189 
   190 !DebugView class methodsFor:'defaults'!
   190 !DebugView class methodsFor:'defaults'!
       
   191 
       
   192 debuggerOnMainDisplayOnly
       
   193     ^ DebuggerOnMainDisplayOnly ? true
       
   194 !
   191 
   195 
   192 defaultIcon
   196 defaultIcon
   193     "return the browsers default window icon"
   197     "return the browsers default window icon"
   194 
   198 
   195     <resource: #programImage>
   199     <resource: #programImage>
   500      This is the standard way of entering the debugger;
   504      This is the standard way of entering the debugger;
   501      sent from error- and halt messages."
   505      sent from error- and halt messages."
   502 
   506 
   503     <context: #return>
   507     <context: #return>
   504 
   508 
       
   509     |display|
       
   510 
   505     (NumberOfDebuggers ? 0) > self maxNumberOfDebuggers ifTrue:[
   511     (NumberOfDebuggers ? 0) > self maxNumberOfDebuggers ifTrue:[
   506         NumberOfDebuggers := self allInstances count:[:d | d isOpen].
   512         NumberOfDebuggers := self allInstances count:[:d | d isOpen].
   507         NumberOfDebuggers > self maxNumberOfDebuggers ifTrue:[
   513         NumberOfDebuggers > self maxNumberOfDebuggers ifTrue:[
   508             MiniDebugger enter:aContext withMessage:'too many debuggers - looping?' mayProceed:true.
   514             MiniDebugger enter:aContext withMessage:'too many debuggers - looping?' mayProceed:true.
   509         ].
   515         ].
   511 
   517 
   512     DebuggingDebugger == true ifTrue:[
   518     DebuggingDebugger == true ifTrue:[
   513         '==> enter1: (' print. aContext print. ')' printCR.
   519         '==> enter1: (' print. aContext print. ')' printCR.
   514     ].
   520     ].
   515 
   521 
   516     StepInterruptPending := nil.
   522     display := (self debuggerOnMainDisplayOnly)
   517     ControlInterrupt handle:[:ex |
   523                 ifTrue:[ Display ]
   518         'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.
   524                 ifFalse:[ Screen current ].
   519         ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
   525 
   520         ex proceed
   526     Screen currentScreenQuerySignal answer:display
   521     ] do:[
   527     do:[
   522         |debugger|
   528         StepInterruptPending := nil.
   523 
   529         ControlInterrupt handle:[:ex |
   524         "
   530             'DebugView [info]: breakpoint in debugger setup ignored [enter.]' infoPrintCR.
   525          well, it could be a stepping or sending debugger up there;
   531             ('DebugView [info]: breakpoint on:' , ex suspendedContext printString) infoPrintCR.
   526          in this case, return to it. This happens, when a stepping process
   532             ex proceed
   527          runs into an error (for example, a halt). In this case, we want the
   533         ] do:[
   528          stepping debugger to come up again instead of a new one.
   534             |debugger|
   529         "
   535 
   530         (debugger := self openDebuggerForActiveProcess) notNil ifTrue:[
   536             "
   531             debugger unstep.
   537              well, it could be a stepping or sending debugger up there;
   532             debugger setLabelFor:aString in:Processor activeProcess.
   538              in this case, return to it. This happens, when a stepping process
   533             debugger mayProceed:mayProceed.
   539              runs into an error (for example, a halt). In this case, we want the
   534             ^ debugger enter:aContext select:nil.
   540              stepping debugger to come up again instead of a new one.
   535         ].
   541             "
   536     ].
   542             (debugger := self openDebuggerForActiveProcess) notNil ifTrue:[
   537     ^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
   543                 debugger unstep.
       
   544                 debugger setLabelFor:aString in:Processor activeProcess.
       
   545                 debugger mayProceed:mayProceed.
       
   546                 ^ debugger enter:aContext select:nil.
       
   547             ].
       
   548         ].
       
   549         ^ self enterUnconditional:aContext withMessage:aString mayProceed:mayProceed
       
   550     ].
   538 
   551 
   539     "Modified: / 06-11-2013 / 20:58:54 / cg"
   552     "Modified: / 06-11-2013 / 20:58:54 / cg"
   540 !
   553 !
   541 
   554 
   542 enterException:ex
   555 enterException:ex
   614     "return a new DebugView.
   627     "return a new DebugView.
   615      - return a cached debugger if it already exists.
   628      - return a cached debugger if it already exists.
   616      Also, care for remote displays on which no debugger is wanted
   629      Also, care for remote displays on which no debugger is wanted
   617      (ask with mayOpenDebugger) - if so, open on the default screen."
   630      (ask with mayOpenDebugger) - if so, open on the default screen."
   618 
   631 
   619     |debugger currentScreen debuggerDevice|
   632     |debugger currentScreen debuggerScreen|
   620 
   633 
   621     currentScreen := Screen current.
   634     currentScreen := Screen current.
   622 
   635 
   623     currentScreen notNil ifTrue:[
   636     currentScreen notNil ifTrue:[
   624         (currentScreen suppressDebugger) ifTrue:[
   637         (currentScreen suppressDebugger) ifTrue:[
   625             "/ no debuggers with that device - show an alertBox which aborts...
   638             "/ no debuggers with that device - show an alertBox which aborts...
   626             ^ nil.
   639             ^ nil.
   627         ].
   640         ].
   628         (currentScreen mayOpenDebugger) ifFalse:[
   641         (currentScreen mayOpenDebugger) ifFalse:[
   629             "/ no debugger on that device - but on the main screen
   642             "/ no debugger on that device - but on the main screen
   630             currentScreen := Screen default.
   643             currentScreen := Display ? Screen default.
   631         ].
   644         ].
   632     ].
   645     ].
   633 
   646 
   634     "
   647     "
   635      need a blocking debugger if no processes or
   648      need a blocking debugger if no processes or
   655         ].
   668         ].
   656 
   669 
   657         (debugger := CachedDebugger) notNil ifTrue:[
   670         (debugger := CachedDebugger) notNil ifTrue:[
   658             CachedDebugger := nil.
   671             CachedDebugger := nil.
   659         ] ifFalse:[
   672         ] ifFalse:[
   660             debuggerDevice := currentScreen.
   673             debuggerScreen := currentScreen.
   661             debuggerDevice isNil ifTrue:[
   674             debuggerScreen isNil ifTrue:[
   662                 "/ use the default display
   675                 "/ use the default display
   663                 debuggerDevice := Screen default.
   676                 debuggerScreen := Screen default.
   664             ].
   677             ].
   665             (debuggerDevice isNil
   678             (debuggerScreen isNil
   666             or:[debuggerDevice isOpen not
   679             or:[debuggerScreen isOpen not
   667             "/ or:[debuggerDevice mayOpenDebugger not]
   680             "/ or:[debuggerDevice mayOpenDebugger not]
   668             ]) ifTrue:[
   681             ]) ifTrue:[
   669                 "/ no debugger
   682                 "/ no debugger
   670                 ^ nil.
   683                 ^ nil.
   671             ].
   684             ].
   672 
   685 
   673             Screen currentScreenQuerySignal answer:debuggerDevice
   686             Screen currentScreenQuerySignal answer:debuggerScreen
   674             do:[
   687             do:[
   675                 debugger := super new.
   688                 debugger := super new.
   676             ].
   689             ].
   677             debugger label:'Debugger'.
   690             debugger label:'Debugger'.
   678             debugger icon:self defaultIcon.
   691             debugger icon:self defaultIcon.
  9424 ! !
  9437 ! !
  9425 
  9438 
  9426 !DebugView class methodsFor:'documentation'!
  9439 !DebugView class methodsFor:'documentation'!
  9427 
  9440 
  9428 version
  9441 version
  9429     ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
  9442     ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
  9430 !
  9443 !
  9431 
  9444 
  9432 version_CVS
  9445 version_CVS
  9433     ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
  9446     ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
  9434 !
  9447 !
  9435 
  9448 
  9436 version_SVN
  9449 version_SVN
  9437     ^ '$Id: DebugView.st,v 1.664 2014-07-26 07:55:23 cg Exp $'
  9450     ^ '$Id: DebugView.st,v 1.665 2014-08-03 12:42:03 cg Exp $'
  9438 ! !
  9451 ! !
  9439 
  9452 
  9440 
  9453 
  9441 DebugView initialize!
  9454 DebugView initialize!