--- a/Tools__BreakpointBrowser.st Sun Oct 25 17:18:37 2009 +0100
+++ b/Tools__BreakpointBrowser.st Mon Oct 26 11:10:41 2009 +0100
@@ -16,10 +16,10 @@
ApplicationModel subclass:#BreakpointBrowser
instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
selectionIndexHolder currentSortColumn currentSortIsReverse
- showHalts showAssertions showCodeBreakpoints
- showCodeBreakpointsFor showMethodBreakpoints codeView infoHolder
- updateProcess'
- classVariableNames:''
+ showHalts showOthers showAssertions showCodeBreakpoints
+ showCodeBreakpointsFor showMethodBreakpoints showDebugCode
+ codeView infoHolder updateProcess showWhichHaltsHolder'
+ classVariableNames:'MessagesAndTypes'
poolDictionaries:''
category:'Interface-Smalltalk-Breakpoints'
!
@@ -63,6 +63,29 @@
"
! !
+!BreakpointBrowser class methodsFor:'initialization'!
+
+defaultListOfMessagesAndTypes
+ "the set of messages which are shown;
+ you can add your own one's with a #other categorization"
+
+ ^ #(
+ (#breakPoint: #breakPoint)
+ (#breakPoint:info: #breakPoint)
+ (#debuggingCodeFor:is: #debugCode)
+ (#halt #halt)
+ (#halt: #halt)
+ (#assert: #assertion)
+ (#assert:message: #assertion)
+ (#todo #other)
+ (#todo: #other)
+ ).
+!
+
+initialize
+ MessagesAndTypes := self defaultListOfMessagesAndTypes
+! !
+
!BreakpointBrowser class methodsFor:'interface specs'!
windowSpec
@@ -235,6 +258,7 @@
(Menu
(
(MenuItem
+ enabled: hasSelectionHolder
label: 'Browse'
itemValue: browseSelectedItem
translateLabel: true
@@ -273,7 +297,37 @@
indication: showHalts
)
(MenuItem
- label: '-'
+ enabled: showHalts
+ label: ' '
+ translateLabel: true
+ submenu:
+ (Menu
+ (
+ (MenuItem
+ label: 'All Halts'
+ nameKey: AllHalts
+ translateLabel: true
+ choice: showWhichHaltsHolder
+ choiceValue: all
+ )
+ (MenuItem
+ label: 'Enabled Halts'
+ nameKey: EnabledHalts
+ translateLabel: true
+ choice: showWhichHaltsHolder
+ choiceValue: enabled
+ )
+ (MenuItem
+ label: 'Ignored Halts'
+ nameKey: IgnoredHalts
+ translateLabel: true
+ choice: showWhichHaltsHolder
+ choiceValue: ignored
+ )
+ )
+ nil
+ nil
+ )
)
(MenuItem
label: 'Code Breakpoints'
@@ -289,6 +343,20 @@
submenuChannel: codeBreakpointMenu
)
(MenuItem
+ label: 'Debug Code'
+ itemValue: showDebugCode:
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showDebugCode
+ )
+ (MenuItem
+ label: 'Other Debug Messages'
+ itemValue: showOthers:
+ translateLabel: true
+ hideMenuOnActivated: false
+ indication: showOthers
+ )
+ (MenuItem
label: '-'
)
(MenuItem
@@ -694,6 +762,12 @@
!
+messagesAndTypes
+ "the spec of selectors to offer"
+
+ ^ MessagesAndTypes
+!
+
selectedBreakpointListEntry
self selectionIndex isNil ifTrue:[^ nil].
^ self breakpointListEntryAtIndex:(self selectionIndex).
@@ -780,6 +854,15 @@
self updateShownBreakpointList
!
+showDebugCode
+ ^ showDebugCode ? true
+!
+
+showDebugCode:aBoolean
+ showDebugCode := aBoolean.
+ self updateShownBreakpointList
+!
+
showHalts
^ showHalts ? true
!
@@ -796,6 +879,23 @@
showMethodBreakpoints:aBoolean
showMethodBreakpoints := aBoolean.
self updateShownBreakpointList
+!
+
+showOthers
+ ^ showOthers ? true
+!
+
+showOthers:aBoolean
+ showOthers := aBoolean.
+ self updateShownBreakpointList
+!
+
+showWhichHaltsHolder
+ showWhichHaltsHolder isNil ifTrue:[
+ showWhichHaltsHolder := #all asValue.
+ showWhichHaltsHolder onChangeSend:#updateShownBreakpointList to:self
+ ].
+ ^ showWhichHaltsHolder
! !
!BreakpointBrowser methodsFor:'change & update'!
@@ -808,29 +908,59 @@
!
filter
- |newList|
+ "filter those items which are to be shown from the complete list"
+
+ |newList showWhichHalt|
newList := breakpointList.
- self showHalts ifFalse:[
- newList := newList reject:[:entry | entry isHalt].
+
+ self showOthers ifFalse:[
+ newList := newList reject:[:entry | entry isOther].
].
- self showCodeBreakpoints ifFalse:[
- newList := newList reject:[:entry | entry isCodeBreakpoint].
- ] ifTrue:[
- newList := newList reject:[:entry |
- |flag|
-
- flag := (showCodeBreakpointsFor at:(entry arg ? '<nil>') ifAbsentPut:[true asValue]) value.
- entry isCodeBreakpoint
- and:[ flag not ]
- ].
+ self showDebugCode ifFalse:[
+ newList := newList reject:[:entry | entry isDebugCode].
].
self showMethodBreakpoints ifFalse:[
- newList := newList reject:[:entry | entry isMethodBreakpoint].
+ newList := newList reject:[:entry | entry isMethodBreakpoint].
].
self showAssertions ifFalse:[
- newList := newList reject:[:entry | entry isAssertion].
+ newList := newList reject:[:entry | entry isAssertion].
].
+
+ self showHalts ifFalse:[
+ newList := newList reject:[:entry | entry isHalt].
+ ] ifTrue:[
+ showWhichHalt := showWhichHaltsHolder value.
+ showWhichHalt ~~ #all ifTrue:[
+ newList := newList reject:[:entry |
+ entry isHalt
+ and:[
+ |showInList isIgnored|
+
+ showInList := true.
+ isIgnored := Debugger isHaltToBeIgnoredIn:entry method atLineNr:entry lineNumber.
+ showWhichHalt == #ignored ifTrue:[
+ showInList := isIgnored
+ ] ifFalse:[
+ showInList := isIgnored not
+ ].
+ showInList not]
+ ].
+ ].
+ ].
+
+ self showCodeBreakpoints ifFalse:[
+ newList := newList reject:[:entry | entry isCodeBreakpoint].
+ ] ifTrue:[
+ newList := newList reject:[:entry |
+ |flag|
+
+ flag := (showCodeBreakpointsFor at:(entry arg ? '<nil>') ifAbsentPut:[true asValue]) value.
+ entry isCodeBreakpoint
+ and:[ flag not ]
+ ].
+ ].
+
shownCopyOfBreakpointList contents:newList.
!
@@ -838,18 +968,6 @@
^ (self messagesAndTypes collect:[:each | each first]) asSet.
!
-messagesAndTypes
- ^ #(
- (#breakPoint: #breakPoint)
- (#breakPoint:info: #breakPoint)
- (#debuggingCodeFor:is: #debugCode)
- (#halt #halt)
- (#halt: #halt)
- (#assert: #assertion)
- (#assert:message: #assertion)
- ).
-!
-
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
something == #methodInClass ifTrue:[
@@ -924,6 +1042,8 @@
entry lineNumber notNil ifTrue:[
codeView cursorLine:entry lineNumber col:1.
codeView selectLine:entry lineNumber.
+ ] ifFalse:[
+ self breakPoint:#cg.
].
codeView
acceptAction:[:newText |
@@ -996,6 +1116,33 @@
self updateCode
!
+updateList
+ updateProcess notNil ifTrue:[^ self ].
+
+ self updatingLabelShown value:true.
+ "/ cg: mhmh why is this needed ????
+ Delay waitForSeconds:0.1.
+ self windowGroup repairDamage.
+
+ updateProcess :=
+ [
+ [
+ ActivityNotification handle:[:ex |
+ self infoHolder value:ex errorString.
+ self windowGroup processExposeEvents.
+ ex proceed.
+ ] do:[
+ self updateBreakpointList.
+ self updateShownBreakpointList.
+ ]
+ ] ensure:[
+ updateProcess := nil.
+ self updatingLabelShown value:false.
+ ].
+ ] newProcess.
+ updateProcess resume.
+!
+
updateShownBreakpointList
self shownCopyOfBreakpointList contents:breakpointList.
@@ -1011,7 +1158,9 @@
rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
do:aBlock
- |entry type messagesSent|
+ |entry type messagesSent showWhichHalt|
+
+ showWhichHalt := self showWhichHaltsHolder value.
mthd isWrapped ifTrue:[
mthd isBreakpointed ifTrue:[
@@ -1048,7 +1197,14 @@
"/ to fetch all message selectors. This should be done only once,
"/ and not for every selector we look for)
(messagesSent includesIdentical:bpSel) ifTrue:[
- tree := mthd parseTree.
+ tree := RBParser
+ parseMethod:mthd source
+ onError:[:aString :pos |
+ ('BreakPointBrowser [info]: error while parsing "%1": %2'
+ bindWith:mthd whoString with:aString) infoPrintCR.
+ nil
+ ].
+
tree isNil ifTrue:[
entry := BreakpointListEntry new.
entry
@@ -1063,25 +1219,30 @@
] ifFalse:[
extractor := MessageArgumentExtractor new.
extractor selectorToSearch:bpSel.
- extractor callBack:[:lineNo :argument :infoMessage |
- argument notNil ifTrue:[
- newShowCodeBreakpointsFor
- at:argument
- put:(showCodeBreakpointsFor
- at:argument
- ifAbsent:[true asValue])
+ extractor
+ callBack:[:lineNo :argument :infoMessage |
+ |showIt isIgnored|
+
+ argument notNil ifTrue:[
+ newShowCodeBreakpointsFor
+ at:argument
+ put:(showCodeBreakpointsFor
+ at:argument
+ ifAbsent:[true asValue])
+ ].
+ entry := BreakpointListEntry new.
+ entry
+ type:type
+ arg:argument
+ className:cls name
+ selector:sel
+ lineNumber:lineNo
+ info:infoMessage
+ enabled:true.
+
+ aBlock value:entry
].
- entry := BreakpointListEntry new.
- entry
- type:type
- arg:argument
- className:cls name
- selector:sel
- lineNumber:lineNo
- info:infoMessage
- enabled:true.
- aBlock value:entry
- ].
+
tree acceptVisitor:extractor.
]
].
@@ -1254,6 +1415,61 @@
"Modified: / 27-03-2007 / 10:54:29 / cg"
! !
+!BreakpointBrowser methodsFor:'tests'!
+
+aMethodWith_assert
+ "only here for demonstration purposes - should be found in the list"
+
+ self assert:(3 > 4)
+!
+
+aMethodWith_assert2
+ "only here for demonstration purposes - should be found in the list"
+
+ self assert:(3 > 4) message:'well - that ought to work'
+!
+
+aMethodWith_breakPoint
+ "only here for demonstration purposes - should be found in the list"
+
+ self breakPoint:#cg
+!
+
+aMethodWith_breakPoint2
+ "only here for demonstration purposes - should be found in the list"
+
+ self breakPoint:#cg info:'hello there'
+!
+
+aMethodWith_debugCode
+ "only here for demonstration purposes - should be found in the list"
+
+ self
+ debuggingCodeFor:#cg
+ is:[
+ self bla.
+ Transcript show:'some debug prints here'
+ ].
+!
+
+aMethodWith_halt
+ "only here for demonstration purposes - should be found in the list"
+
+ self halt
+!
+
+aMethodWith_halt2
+ "only here for demonstration purposes - should be found in the list"
+
+ self halt:'some message'
+!
+
+aMethodWith_todo
+ "only here for demonstration purposes - should be found in the list"
+
+ self todo
+! !
+
!BreakpointBrowser methodsFor:'user actions'!
browseSelectedItem
@@ -1342,33 +1558,6 @@
self resort.
"Created: / 25-10-2006 / 00:54:59 / cg"
-!
-
-updateList
- updateProcess notNil ifTrue:[^ self ].
-
- self updatingLabelShown value:true.
- "/ cg: mhmh why is this needed ????
- Delay waitForSeconds:0.1.
- self windowGroup repairDamage.
-
- updateProcess :=
- [
- [
- ActivityNotification handle:[:ex |
- self infoHolder value:ex errorString.
- self windowGroup processExposeEvents.
- ex proceed.
- ] do:[
- self updateBreakpointList.
- self updateShownBreakpointList.
- ]
- ] ensure:[
- updateProcess := nil.
- self updatingLabelShown value:false.
- ].
- ] newProcess.
- updateProcess resume.
! !
!BreakpointBrowser::BreakpointListEntry methodsFor:'accessing'!
@@ -1440,12 +1629,20 @@
^ type == #breakPoint
!
+isDebugCode
+ ^ type == #debugCode
+!
+
isHalt
^ type == #halt
!
isMethodBreakpoint
^ type == #wrap
+!
+
+isOther
+ ^ type == #other
! !
!BreakpointBrowser::MessageArgumentExtractor methodsFor:'accessing'!
@@ -1511,9 +1708,11 @@
!BreakpointBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.15 2009-10-22 13:58:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.16 2009-10-26 10:10:41 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.15 2009-10-22 13:58:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.16 2009-10-26 10:10:41 cg Exp $'
! !
+
+BreakpointBrowser initialize!