DebugView.st
changeset 8170 f958ad430417
parent 8161 c3a91c963a35
child 8171 93039ca52c1b
--- a/DebugView.st	Fri May 30 17:08:45 2008 +0200
+++ b/DebugView.st	Mon Jun 02 12:12:56 2008 +0200
@@ -25,14 +25,22 @@
 		firstContext stepHow cachable currentMethod ignoreBreakpoints
 		stepUntilEntering lastStepUntilEntering
 		lastSelectionInReceiverInspector lastSelectionInContextInspector
-		canShowMore exitAbort reportButton setOfHiddenCallingSelectors'
+		canShowMore exitAbort reportButton setOfHiddenCallingSelectors
+		isStoppedAtHaltOrBreakPoint'
 	classVariableNames:'CachedDebugger CachedExclusive OpenDebuggers MoreDebuggingDetail
 		DebuggingDebugger DefaultDebuggerBackgroundColor
-		InitialNChainShown'
+		InitialNChainShown IgnoredHalts'
 	poolDictionaries:''
 	category:'Interface-Debugger'
 !
 
+Object subclass:#IgnoredHalt
+	instanceVariableNames:'method lineNumber ignoreEndTime ignoreCount'
+	classVariableNames:''
+	poolDictionaries:''
+	privateIn:DebugView
+!
+
 !DebugView class methodsFor:'documentation'!
 
 copyright
@@ -665,6 +673,40 @@
                   translateLabel: true
                   indication: allowBreakPointsInDebugger
                 )
+
+               (MenuItem
+                  label: 'Ignore'
+                  translateLabel: true
+                  submenu: 
+                 (Menu
+                    (
+                     (MenuItem
+                  enabled: isStoppedAtHaltOrBreakPoint
+                        label: 'For Some Time...'
+                        itemValue: openIgnoreHaltUntilTimeElapsedDialog
+                        translateLabel: true
+                      )
+                     (MenuItem
+                  enabled: isStoppedAtHaltOrBreakPoint
+                        label: 'For the Next N Times...'
+                        itemValue: openIgnoreHaltNTimesDialog
+                        translateLabel: true
+                      )
+               (MenuItem
+                  label: '-'
+                )
+               (MenuItem
+                  enabled: hasHaltsToIgnore
+                  label: 'Stop Ignoring All'
+                  itemValue: stopIgnoringHalts
+                  translateLabel: true
+                )
+
+                     )
+                    nil
+                    nil
+                  )
+                )
                )
               nil
               nil
@@ -700,8 +742,6 @@
         nil
         nil
       )
-
-    "Modified: / 15-05-2007 / 13:31:52 / cg"
 ! !
 
 !DebugView class methodsFor:'misc'!
@@ -997,7 +1037,8 @@
 
     <context: #return>
 
-    |con m enteredByInterrupt sel iAmNew foundNoByteCodeContext foundExitContext c|
+    |con m enteredByInterrupt sel iAmNew foundNoByteCodeContext foundExitContext haltingMethod lineNrInHaltingMethod
+     c|
 
     DebuggingDebugger == true ifTrue:[
         '==> enter: (' print. aContext print.
@@ -1044,11 +1085,38 @@
 
 "/'entering: ' print. aContext printCR.
 "/'initial: ' print. initialSelectionOrNil printCR.
+    thisContext sender fixAllLineNumbers. "/ _CONTEXTLINENOS(s)
+
+    "/ should a halt be ignored ?
+    IgnoredHalts notNil ifTrue:[
+        c := thisContext findNextContextWithSelector:#halt or:#halt: or:nil.
+        c notNil ifTrue:[
+            c := c sender.
+            haltingMethod := c method.
+            lineNrInHaltingMethod := c lineNumber.
+            IgnoredHalts do:[:ign | 
+                (ign isHaltIgnoredInMethod:haltingMethod line:lineNrInHaltingMethod) ifTrue:[
+Transcript showCR:'ignored halt in ', haltingMethod printString.
+                    ign decrementIgnoreCount.
+                    ign isHaltIgnored ifFalse:[
+Transcript showCR:'no longer ignore halt in ', haltingMethod printString.
+                        IgnoredHalts remove:ign ifAbsent:[].    
+                    ].
+                    ^ self.
+                ].
+            ].
+            IgnoredHalts do:[:ign | 
+                (ign isForMethod:haltingMethod line:lineNrInHaltingMethod) ifTrue:[
+                    IgnoredHalts remove:ign ifAbsent:[].    
+                ].
+            ].
+        ]
+    ].
+
     iAmNew := drawableId isNil.
 
     verboseBacktrace := UserPreferences current verboseBacktraceInDebugger.
 
-    thisContext sender fixAllLineNumbers. "/ _CONTEXTLINENOS(s)
     busy := cachable := true.
     inspecting := false.
     inspectedProcess := Processor activeProcess.
@@ -3861,6 +3929,24 @@
     OperatingSystem exit
 !
 
+findHaltingContext
+    contextArray keysAndValuesDo:[:idx :con |
+        |sel|
+
+        sel := con selector.
+        (sel == #halt or:[sel == #halt:]) ifTrue:[
+            con method mclass == Object ifTrue:[
+                ^ contextArray at:idx+1
+            ].
+        ].
+    ].
+    ^ nil
+!
+
+hasHaltsToIgnore
+    ^ IgnoredHalts notEmptyOrNil
+!
+
 inspectContext
     "launch an inspector on the currently selected context"
 
@@ -3871,6 +3957,10 @@
     ]
 !
 
+isStoppedAtHaltOrBreakPoint
+    ^ isStoppedAtHaltOrBreakPoint
+!
+
 middleButtonMenu
     <resource: #programMenu >
 
@@ -3979,6 +4069,36 @@
     "Modified: / 12-09-2006 / 17:20:38 / cg"
 !
 
+openIgnoreHaltNTimesDialog
+    |answer n haltingContext haltingMethod lineNrOfHalt
+     oldEntry ign|
+
+    answer := Dialog request:'How often should this halt be ignored?'.
+    answer isEmptyOrNil ifTrue:[^ nil].
+    n := Integer readFrom:answer onError:nil.
+    n isNil ifTrue:[^ nil].
+
+    haltingContext := self findHaltingContext.
+    haltingMethod := haltingContext method.
+    lineNrOfHalt := haltingContext lineNumber.
+
+    IgnoredHalts notNil ifTrue:[
+        oldEntry := IgnoredHalts 
+                        detect:[:ign | ign isForMethod:haltingMethod line:lineNrOfHalt]
+                        ifNone:nil.
+        IgnoredHalts remove:oldEntry ifAbsent:[].
+    ].
+
+    n > 0 ifTrue:[
+        IgnoredHalts isNil ifTrue:[
+            IgnoredHalts := OrderedCollection new.
+        ].
+        ign := IgnoredHalt new method:haltingMethod lineNumber:lineNrOfHalt.
+        ign ignoreCount:n.
+        IgnoredHalts add:ign.
+    ].
+!
+
 quickTerminate
     "quick terminate - the process will get no chance for cleanup actions"
 
@@ -4129,6 +4249,10 @@
     "Modified: 3.3.1997 / 20:56:32 / cg"
 !
 
+stopIgnoringHalts
+    IgnoredHalts := nil
+!
+
 toggleVerboseWalkback
     verboseBacktrace ifFalse:[
         self showVerboseWalkback
@@ -4653,6 +4777,7 @@
         ^ false
     ].
 
+    isStoppedAtHaltOrBreakPoint := false.
     firstContext := aContext.
 
     m := contextView middleButtonMenu.
@@ -4699,29 +4824,34 @@
             ].
         ].
 
-        verboseBacktrace ~~ true ifTrue:[
-            con notNil ifTrue:[    
-                "/ hide the halt implementation
-                (#(halt halt:) includes:con selector) ifTrue:[
-                    con method mclass == Object ifTrue:[
+        con notNil ifTrue:[    
+            "/ hide the halt implementation
+            (#(halt halt:) includes:con selector) ifTrue:[
+                (con method notNil and:[con method mclass == Object]) ifTrue:[
+                    isStoppedAtHaltOrBreakPoint := true.
+                    verboseBacktrace ~~ true ifTrue:[
                         calledContext := con.
                         con := con sender.
                     ]
                 ].
             ]
         ].
-
         "
          get them all
         "
         count := 0.
         [con notNil and:[count <= nChainShown]] whileTrue:[
+            (#(halt halt:) includes:con selector) ifTrue:[
+                (con method notNil and:[con method mclass == Object]) ifTrue:[
+                    isStoppedAtHaltOrBreakPoint := true.
+                ]
+            ].
+
             [ 
                 DebuggingDebugger == true ifTrue:[
                     'showingContext1: (' print. con print.
                     ') --> ' print. (self showingContext1:con calling:calledContext) printCR.
                 ].
-
                 self showingContext1:con calling:calledContext
             ] whileFalse:[
                 calledContext := con.
@@ -6081,10 +6211,66 @@
     ]
 ! !
 
+!DebugView::IgnoredHalt methodsFor:'accessing'!
+
+ignoreCount:something
+    ignoreCount := something.
+!
+
+ignoreEndTime:something
+    ignoreEndTime := something.
+!
+
+method
+    ^ method 
+!
+
+method:methodArg lineNumber:lineNumberArg 
+    method := methodArg.
+    lineNumber := lineNumberArg.
+! !
+
+!DebugView::IgnoredHalt methodsFor:'misc'!
+
+decrementIgnoreCount
+    ignoreCount notNil ifTrue:[
+        ignoreCount > 0 ifTrue:[
+            ignoreCount := ignoreCount - 1
+        ]
+    ]
+! !
+
+!DebugView::IgnoredHalt methodsFor:'queries'!
+
+isForMethod:aMethod line:line
+    line = lineNumber ifFalse:[^ false].
+    method == aMethod ifFalse:[^ false].
+
+    ^ true
+!
+
+isHaltIgnored
+    ignoreCount notNil ifTrue:[
+        ^ ignoreCount > 0 
+    ].
+    ignoreEndTime notNil ifTrue:[
+        ^ ignoreEndTime > Timestamp now
+    ].
+
+    ^ true
+!
+
+isHaltIgnoredInMethod:aMethod line:line
+    line = lineNumber ifFalse:[^ false].
+    method == aMethod ifFalse:[^ false].
+
+    ^ self isHaltIgnored
+! !
+
 !DebugView class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.434 2008-05-30 12:25:08 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/DebugView.st,v 1.435 2008-06-02 10:12:56 cg Exp $'
 ! !
 
 DebugView initialize!