class: Tools::BreakpointBrowser
authorClaus Gittinger <cg@exept.de>
Thu, 28 Mar 2013 16:00:28 +0100
changeset 12561 0766dc3e8079
parent 12560 27c2f7b1baa4
child 12562 e05279313989
class: Tools::BreakpointBrowser added package and class filter; show ignore status category
Tools__BreakpointBrowser.st
--- a/Tools__BreakpointBrowser.st	Thu Mar 28 01:14:16 2013 +0100
+++ b/Tools__BreakpointBrowser.st	Thu Mar 28 16:00:28 2013 +0100
@@ -19,10 +19,10 @@
 		showHalts showOthers showAssertions showAssertionsInTests
 		showCodeBreakpoints showCodeBreakpointsFor showMethodBreakpoints
 		showLineBreakpoints showDebugCode codeView infoHolder
-		updateProcess showWhichHaltsHolder'
+		updateProcess showWhichHaltsHolder packageFilter classNameFilter'
 	classVariableNames:'MessagesAndTypes'
 	poolDictionaries:''
-	category:'Interface-Smalltalk-Breakpoints'
+	category:'Interface-Debugger'
 !
 
 Object subclass:#BreakpointListEntry
@@ -406,6 +406,24 @@
             )
           )
          (MenuItem
+            label: 'Filter'
+            submenu: 
+           (Menu
+              (
+               (MenuItem
+                  label: 'Package Filter...'
+                  itemValue: openPackageFilterDialog
+                )
+               (MenuItem
+                  label: 'Class Filter...'
+                  itemValue: openClassFilterDialog
+                )
+               )
+              nil
+              nil
+            )
+          )
+         (MenuItem
             label: 'Enable'
             submenu: 
            (Menu
@@ -563,18 +581,14 @@
          model: selector
          canSelect: false
        )
-"/      (DataSetColumnSpec
-"/         label: 'Line'
-"/         labelAlignment: left
-"/         activeHelpKey: ''
-"/         activeHelpKeyForLabel: ''
-"/         labelButtonType: Button
-"/         labelActionSelector: sortBy:
-"/         labelActionArgument: 'lineNumber'
-"/         width: 35
-"/         model: lineNumber
-"/         canSelect: false
-"/       )
+      (DataSetColumnSpec
+         label: 'Ign'
+         labelButtonType: Button
+         columnAlignment: center
+         width: 50
+         model: isIgnored
+         menuFromApplication: false
+       )
       (DataSetColumnSpec
          label: 'Info'
          labelAlignment: left
@@ -587,6 +601,7 @@
          canSelect: false
        )
       )
+    
 !
 
 tableColumns_v1
@@ -987,6 +1002,13 @@
 
     newList := breakpointList.
 
+    classNameFilter notEmptyOrNil ifTrue:[
+        newList := newList select:[:entry | entry relatedToClass:classNameFilter].
+    ].
+    packageFilter notEmptyOrNil ifTrue:[
+        newList := newList select:[:entry | entry relatedToPackage:packageFilter].
+    ].
+
     self showOthers ifFalse:[
         newList := newList reject:[:entry | entry isOther].
     ].
@@ -1525,25 +1547,25 @@
 !
 
 aMethodWith_assert2
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self assert:(3 > 4) message:'well - that ought to work'
 !
 
 aMethodWith_breakPoint
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self breakPoint:#cg
 !
 
 aMethodWith_breakPoint2
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self breakPoint:#cg info:'hello there'
 !
 
 aMethodWith_debugCode
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self 
         debuggingCodeFor:#cg
@@ -1554,7 +1576,7 @@
 !
 
 aMethodWith_halt
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self halt
 
@@ -1568,13 +1590,13 @@
 !
 
 aMethodWith_halt2
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self halt:'some message'
 !
 
 aMethodWith_todo
-    "only here for demonstration purposes - should be found in the list"
+    "only here for demonstration purposes - should be found in the breakpoint browser''s list"
 
     self todo
 ! !
@@ -1601,10 +1623,41 @@
     "Modified: / 18-02-2007 / 12:56:30 / cg"
 !
 
+openClassFilterDialog
+    |nameOrPattern|
+
+    nameOrPattern := Dialog 
+                        requestClassName:'Only show breakpoints for class(es) matching (empty to show all):'
+                        initialAnswer:(classNameFilter ? '*').
+    nameOrPattern isNil ifTrue:[^ self].    "/ cancel
+    (nameOrPattern isEmpty or:[nameOrPattern = '*']) ifTrue:[
+        classNameFilter := nil.
+    ] ifFalse:[    
+        classNameFilter := nameOrPattern.
+    ].
+    self updateShownBreakpointList
+!
+
 openDocumentation
     HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#BREAKPOINTLIST'.
 !
 
+openPackageFilterDialog
+    |nameOrPattern|
+
+    nameOrPattern := Dialog 
+                        request:'Only show breakpoints for code in package(s) matching (empty to show all):'
+                        list:(Smalltalk allProjectIDs)
+                        initialAnswer:(packageFilter ? '*').
+    nameOrPattern isNil ifTrue:[^ self].    "/ cancel
+    (nameOrPattern isEmpty or:[nameOrPattern = '*']) ifTrue:[
+        packageFilter := nil.
+    ] ifFalse:[    
+        packageFilter := nameOrPattern.
+    ].
+    self updateShownBreakpointList
+!
+
 resort
     |sortBlock sortBlock1|
 
@@ -1713,6 +1766,14 @@
     ^ ignoredInfo ? info
 !
 
+isIgnored
+    type == #halt ifTrue:[
+        (Debugger haltIgnoreInformationFor:self method atLineNr:lineNumber)
+            notNil ifTrue:[^ 'Yes'].
+    ].
+    ^ ''
+!
+
 lineNumber
     ^ lineNumber
 !
@@ -1754,6 +1815,26 @@
     ^ (Smalltalk classNamed:className) compiledMethodAt:selector.
 ! !
 
+!BreakpointBrowser::BreakpointListEntry methodsFor:'queries'!
+
+relatedToClass:aClassNamePattern
+    className isNil ifTrue:[^ true].
+    (aClassNamePattern includesMatchCharacters) ifTrue:[
+         ^ aClassNamePattern match: className
+    ].
+    ^ className startsWith:aClassNamePattern
+!
+
+relatedToPackage:aPackagePattern
+    |package|
+
+    package := self method package.
+    (aPackagePattern includesMatchCharacters) ifTrue:[
+         ^ aPackagePattern match: package
+    ].
+    ^ package startsWith:aPackagePattern
+! !
+
 !BreakpointBrowser::BreakpointListEntry methodsFor:'testing'!
 
 isAssertion
@@ -1860,11 +1941,11 @@
 !BreakpointBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.40 2013-03-26 00:43:36 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.41 2013-03-28 15:00:28 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.40 2013-03-26 00:43:36 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.41 2013-03-28 15:00:28 cg Exp $'
 ! !