"
COPYRIGHT (c) 2008 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
ApplicationModel subclass:#BreakpointBrowser
instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
selectionIndexHolder currentSortColumn currentSortIsReverse
showHalts showOthers showAssertions showCodeBreakpoints
showCodeBreakpointsFor showMethodBreakpoints showDebugCode
codeView infoHolder updateProcess showWhichHaltsHolder'
classVariableNames:'MessagesAndTypes'
poolDictionaries:''
category:'Interface-Smalltalk-Breakpoints'
!
Object subclass:#BreakpointListEntry
instanceVariableNames:'type ignoredInfo arg className selector lineNumber info enabled'
classVariableNames:''
poolDictionaries:''
privateIn:BreakpointBrowser
!
RBProgramNodeVisitor subclass:#MessageArgumentExtractor
instanceVariableNames:'callBack selectorToSearch'
classVariableNames:''
poolDictionaries:''
privateIn:BreakpointBrowser
!
!BreakpointBrowser class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2008 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
tool to list breakpoints (breakPoint/halt/assert)
[author:]
cg (cg@FUSI)
"
! !
!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:'defaults'!
defaultIcon
<resource: #programImage>
^ ToolbarIconLibrary openBreakpointBrowserIcon
! !
!BreakpointBrowser class methodsFor:'interface specs'!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:Tools::BreakpointBrowser andSelector:#windowSpec
Tools::BreakpointBrowser new openInterface:#windowSpec
Tools::BreakpointBrowser open
"
<resource: #canvas>
^
#(FullSpec
name: windowSpec
window:
(WindowSpec
label: 'Breakpoint Browser'
name: 'Breakpoint Browser'
min: (Point 10 10)
bounds: (Rectangle 0 0 680 691)
menu: mainMenu
icon: defaultIcon
)
component:
(SpecCollection
collection: (
(MenuPanelSpec
name: 'ToolBar1'
layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
menu: toolBarMenu
textDefault: true
)
(VariableVerticalPanelSpec
name: 'VariableVerticalPanel1'
layout: (LayoutFrame 0 0 40 0 0 1 0 1)
snapMode: both
component:
(SpecCollection
collection: (
(DataSetSpec
name: 'Table'
model: selectionIndexHolder
menu: itemMenu
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
dataList: shownCopyOfBreakpointList
doubleClickSelector: itemDoubleClicked:
columnHolder: tableColumns
)
(TextEditorSpec
name: 'TextEditor1'
hasHorizontalScrollBar: true
hasVerticalScrollBar: true
hasKeyboardFocusInitially: false
viewClassName: 'CodeView'
postBuildCallback: postBuildCodeView:
)
)
)
handles: (Any 0.5 1.0)
)
(LabelSpec
label: 'Updating - Please Wait...'
name: 'Label1'
layout: (LayoutFrame 0 0 40 0 0 1 0 1)
visibilityChannel: updatingLabelShown
backgroundColor: (Color 100.0 49.999237048905 49.999237048905)
translateLabel: true
)
(ViewSpec
name: 'InfoBox'
layout: (LayoutFrame 0 0 -30 1 0 1 0 1)
visibilityChannel: updatingLabelShown
component:
(SpecCollection
collection: (
(LabelSpec
label: 'Label'
name: 'Label2'
layout: (LayoutFrame 2 0 2 0 680 0 30 0)
level: -1
translateLabel: true
labelChannel: infoHolder
adjust: left
)
)
)
)
)
)
)
! !
!BreakpointBrowser class methodsFor:'menu specs'!
itemMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#itemMenu
(Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser itemMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Browse'
itemValue: browseSelectedItem
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
enabled: selectedItemIsIgnoredHalt
label: 'Stop Ignoring this Halt'
itemValue: reenableHalt
translateLabel: true
)
)
nil
nil
)
!
mainMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#mainMenu
(Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser mainMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'File'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Exit'
itemValue: closeRequest
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'Selection'
translateLabel: true
submenu:
(Menu
(
(MenuItem
enabled: hasSelectionHolder
label: 'Browse'
itemValue: browseSelectedItem
translateLabel: true
)
)
nil
nil
)
)
(MenuItem
label: 'View'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Update List'
itemValue: updateList
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Assertions'
itemValue: showAssertions:
translateLabel: true
hideMenuOnActivated: false
indication: showAssertions
)
(MenuItem
label: 'Halts'
itemValue: showHalts:
translateLabel: true
hideMenuOnActivated: false
indication: showHalts
)
(MenuItem
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'
itemValue: showCodeBreakpoints:
translateLabel: true
hideMenuOnActivated: false
indication: showCodeBreakpoints
)
(MenuItem
enabled: showCodeBreakpoints
label: ' '
translateLabel: true
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
label: 'Method Breakpoints'
itemValue: showMethodBreakpoints:
translateLabel: true
hideMenuOnActivated: false
indication: showMethodBreakpoints
)
)
nil
nil
)
)
(MenuItem
label: 'Enable'
translateLabel: true
submenu:
(Menu
(
(MenuItem
label: 'Assertions'
itemValue: enableAssertions:
translateLabel: true
hideMenuOnActivated: false
indication: enableAssertions
)
(MenuItem
label: 'Halts'
itemValue: enableHalts:
translateLabel: true
hideMenuOnActivated: false
indication: enableHalts
)
(MenuItem
label: '-'
)
(MenuItem
label: 'Code Breakpoints'
translateLabel: true
submenuChannel: enabledCodeBreakpointMenu
)
)
nil
nil
)
)
(MenuItem
label: 'Help'
translateLabel: true
startGroup: right
submenu:
(Menu
(
(MenuItem
label: 'Documentation'
itemValue: openDocumentation
translateLabel: true
)
(MenuItem
label: '-'
)
(MenuItem
label: 'About this Application...'
itemValue: openAboutThisApplication
translateLabel: true
)
)
nil
nil
)
)
)
nil
nil
)
!
toolBarMenu
"This resource specification was automatically generated
by the MenuEditor of ST/X."
"Do not manually edit this!! If it is corrupted,
the MenuEditor may not be able to read the specification."
"
MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#toolBarMenu
(Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser toolBarMenu)) startUp
"
<resource: #menu>
^
#(Menu
(
(MenuItem
label: 'Update List'
itemValue: updateList
translateLabel: true
isButton: true
labelImage: (ResourceRetriever ToolbarIconLibrary reloadIcon)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelectionHolder
label: 'Browse Selected Method'
itemValue: browseSelectedItem
translateLabel: true
isButton: true
labelImage: (ResourceRetriever ToolbarIconLibrary startNewSystemBrowserIcon)
)
)
nil
nil
)
"Modified: / 08-11-2011 / 16:43:49 / cg"
! !
!BreakpointBrowser class methodsFor:'tableColumns specs'!
tableColumns
"This resource specification was automatically generated
by the DataSetBuilder of ST/X."
"Do not manually edit this!! If it is corrupted,
the DataSetBuilder may not be able to read the specification."
"
DataSetBuilder new openOnClass:Tools::BreakpointBrowser andSelector:#tableColumns
"
<resource: #tableColumns>
^#(
(DataSetColumnSpec
label: 'Type'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 70
model: type
canSelect: false
)
(DataSetColumnSpec
label: 'Arg'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 50
model: arg
canSelect: false
)
(DataSetColumnSpec
label: 'Class'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'className'
width: 150
model: className
canSelect: false
)
(DataSetColumnSpec
label: 'Method'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'selector'
width: 200
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: 'Info'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'info'
model: info
canSelect: false
)
)
!
tableColumns_v1
"This resource specification was automatically generated
by the DataSetBuilder of ST/X."
"Do not manually edit this!! If it is corrupted,
the DataSetBuilder may not be able to read the specification."
"
DataSetBuilder new openOnClass:Tools::BreakpointBrowser andSelector:#tableColumns
"
<resource: #tableColumns>
^#(
(DataSetColumnSpec
label: 'Enabled'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
width: 50
editorType: CheckToggle
rendererType: CheckToggle
model: enabled
)
(DataSetColumnSpec
label: 'Type'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 60
model: type
canSelect: false
)
(DataSetColumnSpec
label: 'Arg'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 50
model: arg
canSelect: false
)
(DataSetColumnSpec
label: 'Class'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'className'
width: 150
model: className
canSelect: false
)
(DataSetColumnSpec
label: 'Method'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'selector'
width: 200
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: 'Info'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'info'
model: info
canSelect: false
)
)
!
tableColumns_v2
"This resource specification was automatically generated
by the DataSetBuilder of ST/X."
"Do not manually edit this!! If it is corrupted,
the DataSetBuilder may not be able to read the specification."
"
DataSetBuilder new openOnClass:Tools::BreakpointBrowser andSelector:#tableColumns
"
<resource: #tableColumns>
^#(
(DataSetColumnSpec
label: 'Type'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 70
model: type
canSelect: false
)
(DataSetColumnSpec
label: 'Arg'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'type'
width: 50
model: arg
canSelect: false
)
(DataSetColumnSpec
label: 'Class'
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'className'
width: 150
model: className
canSelect: false
)
(DataSetColumnSpec
label: 'Method'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'selector'
width: 200
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: 'Info'
labelAlignment: left
activeHelpKey: ''
activeHelpKeyForLabel: ''
labelButtonType: Button
labelActionSelector: sortBy:
labelActionArgument: 'info'
model: info
canSelect: false
)
)
! !
!BreakpointBrowser methodsFor:'accessing'!
aboutThisApplicationText
|msg|
msg := super aboutThisApplicationText.
msg := msg , '\\Written by Claus Gittinger (cg@exept.de).'.
^msg withCRs.
!
breakpointListEntryAtIndex:idx
^ shownCopyOfBreakpointList at:idx ifAbsent:nil
!
messagesAndTypes
"the spec of selectors to offer"
^ MessagesAndTypes
!
selectedBreakpointListEntry
self selectionIndex isNil ifTrue:[^ nil].
^ self breakpointListEntryAtIndex:(self selectionIndex).
!
selectionIndex
^ self selectionIndexHolder value
!
shownCopyOfBreakpointList
shownCopyOfBreakpointList isNil ifTrue:[
shownCopyOfBreakpointList := List new
].
^ shownCopyOfBreakpointList
"Created: / 18-02-2007 / 12:53:01 / cg"
!
updatingLabelShown
updatingLabelShown isNil ifTrue:[
updatingLabelShown := true asValue
].
^ updatingLabelShown
! !
!BreakpointBrowser methodsFor:'aspects'!
enableAssertions
^ (Smalltalk at:#IgnoreAssertion ifAbsent:false) not
!
enableAssertions:aBoolean
^ Smalltalk at:#IgnoreAssertion put:aBoolean not
!
enableHalts
^ Smalltalk ignoreHalt not
"Modified: / 18-11-2010 / 11:24:11 / cg"
!
enableHalts:aBoolean
^ Smalltalk ignoreHalt:aBoolean not
"Modified: / 18-11-2010 / 11:30:03 / cg"
!
hasSelectionHolder
^ BlockValue
with:[:selIndex | selIndex notNil and:[selIndex ~~ 0]]
argument:self selectionIndexHolder
!
infoHolder
infoHolder isNil ifTrue:[
infoHolder := nil asValue.
].
^ infoHolder
"Created: / 22-10-2006 / 02:00:41 / cg"
!
selectedItemIsIgnoredHalt
|entry info|
entry := (self breakpointListEntryAtIndex:self selectionIndexHolder value).
info := Debugger haltIgnoreInformationFor:(entry method) atLineNr:(entry lineNumber).
^ info notNil and:[ info isHaltIgnored ].
!
selectionIndexHolder
selectionIndexHolder isNil ifTrue:[
selectionIndexHolder := nil asValue.
selectionIndexHolder onChangeSend:#updateCode to:self
].
^ selectionIndexHolder
"Created: / 22-10-2006 / 02:00:41 / cg"
!
showAssertions
^ showAssertions ? true
!
showAssertions:aBoolean
showAssertions := aBoolean.
self updateShownBreakpointList
!
showCodeBreakpoints
^ showCodeBreakpoints ? true
!
showCodeBreakpoints:aBoolean
showCodeBreakpoints := aBoolean.
self updateShownBreakpointList
!
showDebugCode
^ showDebugCode ? true
!
showDebugCode:aBoolean
showDebugCode := aBoolean.
self updateShownBreakpointList
!
showHalts
^ showHalts ? true
!
showHalts:aBoolean
showHalts := aBoolean.
self updateShownBreakpointList
!
showMethodBreakpoints
^ showMethodBreakpoints ? true
!
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'!
delayedUpdate:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
something == #methodInClass ifTrue:[
self updateForClass:(aParameter first) selector:(aParameter second).
^ self.
].
something == #methodInClassRemoved ifTrue:[
self updateForClass:(aParameter first) selector:(aParameter second).
^ self.
].
something == #ignoredHalts ifTrue:[
self updateShownBreakpointList.
^ self.
].
].
!
filter
"filter those items which are to be shown from the complete list"
|newList showWhichHalt|
newList := breakpointList.
self showOthers ifFalse:[
newList := newList reject:[:entry | entry isOther].
].
self showDebugCode ifFalse:[
newList := newList reject:[:entry | entry isDebugCode].
].
self showMethodBreakpoints ifFalse:[
newList := newList reject:[:entry | entry isMethodBreakpoint].
].
self showAssertions ifFalse:[
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 info|
entry ignoredInfo:nil.
showInList := true.
info := Debugger haltIgnoreInformationFor:(entry method) atLineNr:(entry lineNumber).
isIgnored := info notNil and:[ info isHaltIgnored ].
showWhichHalt == #ignored ifTrue:[
showInList := isIgnored.
isIgnored ifTrue:[ entry ignoredInfo:info haltIgnoredInfoString ].
] 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.
!
messageSelectors
^ self messagesAndTypes collect:[:each | each first] as:Set.
!
update:something with:aParameter from:changedObject
changedObject == Smalltalk ifTrue:[
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
^ self.
].
!
updateBreakpointList
|newShowCodeBreakpointsFor messages messageSelectors update |
breakpointList removeAll.
newShowCodeBreakpointsFor := Dictionary new.
messages := self messagesAndTypes.
messageSelectors := self messageSelectors.
update := [:cls :mthd :sel |
self
withBreakpointListEntriesFor:mthd class:cls selector:sel
messages:messages
messageSelectors:messageSelectors
rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
do:[:newEntry | breakpointList add:newEntry ].
].
Smalltalk allClassesDo:[:cls |
cls selectorsAndMethodsDo:[:sel :mthd |
update value:cls value:mthd value:sel
].
cls class selectorsAndMethodsDo:[:sel :mthd |
update value:cls class value:mthd value:sel
].
].
showCodeBreakpointsFor := newShowCodeBreakpointsFor.
!
updateCode
|entry method class|
entry := self selectedBreakpointListEntry.
entry isNil ifTrue:[
codeView contents:nil.
^ self
].
method := entry method.
method isNil ifTrue:[
codeView contents:'OOPS - no source found'.
] ifFalse:[
codeView contents:(method source).
entry lineNumber notNil ifTrue:[
codeView cursorLine:entry lineNumber col:1.
codeView selectLine:entry lineNumber.
] ifFalse:[
self breakPoint:#cg.
].
codeView
acceptAction:[:newText |
class := method mclass ? (Smalltalk classNamed:entry className).
class
compilerClass
compile:newText asString
forClass:class
inCategory:method category
notifying:codeView.
]
].
!
updateEntry:entry
"after a change, update the list entry.
(or remove it if required)"
|mthd cls sel newShowCodeBreakpointsFor any|
newShowCodeBreakpointsFor := Dictionary new.
breakpointList remove:entry ifAbsent:[].
mthd := entry method.
cls := Smalltalk classNamed:entry className.
sel := entry selector.
any := false.
self
withBreakpointListEntriesFor:mthd class:cls selector:sel
messages:(self messagesAndTypes)
messageSelectors:(self messageSelectors)
rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
do:[:newEntry |
any := true.
breakpointList add:newEntry.
].
!
updateForClass:aClass selector:selector
|selectionIndexBefore mthd affectedEntries newShowCodeBreakpointsFor|
selectionIndexBefore := selectionIndexHolder value.
affectedEntries := breakpointList select:[:entry |
entry selector = selector
and:[ entry className = aClass name ]
].
affectedEntries do:[:eachEntry |
breakpointList remove:eachEntry ifAbsent:[].
].
mthd := aClass compiledMethodAt:selector.
mthd notNil ifTrue:[
newShowCodeBreakpointsFor := Dictionary new.
self
withBreakpointListEntriesFor:mthd class:aClass selector:selector
messages:(self messagesAndTypes)
messageSelectors:(self messageSelectors)
rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
do:[:newEntry |
breakpointList add:newEntry.
].
].
self updateShownBreakpointList.
self selectionIndexHolder value:selectionIndexBefore.
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.
self filter.
self resort.
!
withBreakpointListEntriesFor:mthd class:cls selector:sel
messages:messages
messageSelectors:messageSelectors
rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
do:aBlock
|entry type messagesSent showWhichHalt|
showWhichHalt := self showWhichHaltsHolder value.
mthd isWrapped ifTrue:[
mthd isBreakpointed ifTrue:[
type := #trap
] ifFalse:[
mthd isTraced ifTrue:[
type := #trace
] ifFalse:[
type := #probe
].
].
entry := BreakpointListEntry new.
entry
type:#wrap
arg:type
className:cls name
selector:sel
lineNumber:nil
info:nil
enabled:true.
aBlock value:entry
].
(mthd literalsDetect:[:lit |messageSelectors includes:lit] ifNone:nil) notNil ifTrue:[
messagesSent isNil ifTrue:[
messagesSent := mthd messagesSent.
].
messages pairsDo:[:bpSel :type|
|tree extractor|
"/ used to be (mthd sends:bpSel);
"/ however, the sends requires an expensive parse of the methods source
"/ to fetch all message selectors. This should be done only once,
"/ and not for every selector we look for)
(messagesSent includesIdentical:bpSel) ifTrue:[
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
type:type
arg:nil
className:cls name
selector:sel
lineNumber:nil
info:nil
enabled:true.
aBlock value:entry
] ifFalse:[
extractor := MessageArgumentExtractor new.
extractor selectorToSearch:bpSel.
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
].
tree acceptVisitor:extractor.
]
].
].
].
! !
!BreakpointBrowser methodsFor:'initialization & release'!
initialize
super initialize.
showCodeBreakpointsFor := Dictionary new.
breakpointList := List new.
currentSortColumn := #type.
currentSortIsReverse := false.
Smalltalk addDependent:self.
!
postBuildCodeView:aView
codeView := aView
!
postOpenWith:aBuilder
super postOpenWith:aBuilder.
self enqueueMessage:#updateList for:self arguments:#().
"Modified: / 18-02-2007 / 12:55:57 / cg"
!
release
|p|
(p := updateProcess) notNil ifTrue:[
updateProcess := nil.
p terminate
].
Smalltalk removeDependent:self.
super release
! !
!BreakpointBrowser methodsFor:'menu actions'!
openDocumentation
HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#BREAKPOINTLIST'.
"/ add application-specific help files under the 'doc/online/<language>/help/appName'
"/ directory, and open a viewer with:
"/ HTMLDocumentView openFullOnDocumentationFile:'help/<MyApplication>/TOP.html'.
! !
!BreakpointBrowser methodsFor:'menu actions-item'!
browseItem
self withWaitCursorDo:[
(self breakpointListEntryAtIndex:self selectionIndexHolder value) browse
].
!
reenableHalt
|entry|
entry := self breakpointListEntryAtIndex:self selectionIndexHolder value.
Debugger
ignoreHaltIn:(entry method)
at:(entry lineNumber)
forCount:nil orTimeDuration:nil orUntilShiftKey:false.
self updateShownBreakpointList
"Modified: / 27-01-2012 / 11:34:11 / cg"
!
removeItem
breakpointList remove:(self selectedBreakpointListEntry)
"Created: / 22-10-2006 / 10:45:52 / cg"
"Modified: / 18-02-2007 / 12:57:58 / cg"
! !
!BreakpointBrowser methodsFor:'menus-dynamic'!
codeBreakpointMenu
<resource: #programMenu >
|breakpointArgs menu|
breakpointArgs := Set new.
breakpointList
select:[:entry | entry arg notNil]
thenDo:[:entry | breakpointArgs add:entry arg].
(breakpointList contains:[:entry | entry arg isNil]) ifTrue:[
breakpointArgs add:'<nil>'.
].
breakpointArgs := breakpointArgs asSortedCollection.
menu := Menu new.
menu addItem:(
MenuItem new
label:'Toggle All';
translateLabel:true;
hideMenuOnActivated:false;
itemValue:[
showCodeBreakpointsFor do:[:each |
each value:(each value not)
]
]).
menu addSeparator.
breakpointArgs do:[:arg|
| menuItem |
menuItem := MenuItem new.
menuItem label:arg.
menuItem translateLabel:false.
menuItem indication:(showCodeBreakpointsFor at:arg ifAbsentPut:[true asValue]).
menuItem hideMenuOnActivated:false.
menuItem
itemValue:[:onOff |
(showCodeBreakpointsFor at:arg ifAbsentPut:[true asValue]) value:onOff.
self updateShownBreakpointList
].
menu addItem:menuItem.
].
menu findGuiResourcesIn:self.
^ menu
"Modified (format): / 09-09-2012 / 13:11:14 / cg"
!
enabledCodeBreakpointMenu
<resource: #programMenu >
|breakpointArgs menu enabledCodeBreakpointHolders|
enabledCodeBreakpointHolders := Dictionary new.
breakpointArgs := Set new.
breakpointList
select:[:entry | entry arg notNil]
thenDo:[:entry | breakpointArgs add:entry arg].
(breakpointList contains:[:entry | entry arg isNil]) ifTrue:[
breakpointArgs add:'<nil>'.
].
breakpointArgs := breakpointArgs asSortedCollection.
menu := Menu new.
menu addItem:(
MenuItem new
label:'Toggle All';
translateLabel:true;
hideMenuOnActivated:false;
itemValue:[
enabledCodeBreakpointHolders keysAndValuesDo:[:arg :each |
each value:(each value not).
each value ifTrue:[
Object enableBreakPoint:arg
] ifFalse:[
Object disableBreakPoint:arg
].
]
]).
menu addSeparator.
breakpointArgs do:[:arg|
| menuItem |
menuItem := MenuItem new.
menuItem label:arg.
menuItem translateLabel:false.
menuItem indication:(enabledCodeBreakpointHolders at:arg ifAbsentPut:[ (Object isBreakPointEnabled:arg) asValue ]).
menuItem hideMenuOnActivated:false.
menuItem itemValue:[:onOff |
(enabledCodeBreakpointHolders at:arg ifAbsentPut:[(Object isBreakPointEnabled:arg) asValue]) value:onOff.
onOff ifFalse:[
Object disableBreakPoint:arg
] ifTrue:[
Object enableBreakPoint:arg
].
].
menu addItem:menuItem.
].
menu findGuiResourcesIn:self.
^ menu
"Modified: / 09-09-2012 / 13:11:30 / 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
"after the first halt, in the debugger, ignore this halt for some time and see what
the breakpoint browser shows...
10 timesRepeat:[
self new aMethodWith_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
self withWaitCursorDo:[
(self selectedBreakpointListEntry) browse
].
"Created: / 22-10-2006 / 01:49:13 / cg"
"Modified: / 18-02-2007 / 12:56:30 / cg"
!
itemDoubleClicked:itemIndex
self browseSelectedItem
"Created: / 22-10-2006 / 01:49:13 / cg"
"Modified: / 18-02-2007 / 12:56:30 / cg"
!
resort
|sortBlock sortBlock1|
currentSortColumn isNil ifTrue:[^ self ].
sortBlock := sortBlock1 := [:a :b |
|vA vB|
vA := (a perform:currentSortColumn).
vB := (b perform:currentSortColumn).
vA = vB ifTrue:[
currentSortColumn == #type ifTrue:[
vA := a arg.
vB := b arg.
vA = vB ifTrue:[
vA := a className.
vB := b className.
vA = vB ifTrue:[
vA := a selector.
vB := b selector.
vA = vB ifTrue:[
vA := a lineNumber.
vB := b lineNumber.
]
]
]
]
].
(vA ? '') < (vB ? '')
].
currentSortIsReverse ifTrue:[
sortBlock := [:a :b | (sortBlock1 value:a value:b) not ].
].
"/ temporary hack - should make a copy of the real list
self shownCopyOfBreakpointList sort:sortBlock
"Created: / 25-10-2006 / 01:01:26 / cg"
"Modified: / 18-02-2007 / 13:02:19 / cg"
!
sortBy:instanceName
self sortBy:instanceName withReverse:true
"Created: / 25-10-2006 / 00:53:55 / cg"
!
sortBy:instanceName withReverse:aBoolean
|aSymbol|
aSymbol := instanceName asSymbol.
currentSortColumn isNil ifTrue:[
currentSortColumn := aSymbol.
currentSortIsReverse := false.
] ifFalse:[
currentSortColumn = aSymbol ifTrue:[
"/ same column like before - change sort order ifReverse is true
aBoolean ifTrue:[
currentSortIsReverse := currentSortIsReverse not.
].
] ifFalse:[
"/ another column - remark column
currentSortColumn := aSymbol.
]
].
self resort.
"Created: / 25-10-2006 / 00:54:59 / cg"
! !
!BreakpointBrowser::BreakpointListEntry methodsFor:'accessing'!
arg
^ arg
!
className
^ className
!
enabled
^ enabled
!
ignoredInfo
^ ignoredInfo
!
ignoredInfo:something
ignoredInfo := something.
!
info
^ ignoredInfo ? info
!
lineNumber
^ lineNumber
!
selector
^ selector
!
type
^ type
!
type:typeArg arg:argArg className:classNameArg selector:selectorArg lineNumber:lineNumberArg info:infoArg enabled:enabledArg
type := typeArg.
arg := argArg.
className := classNameArg.
selector := selectorArg.
lineNumber := lineNumberArg.
info := infoArg.
enabled := enabledArg.
! !
!BreakpointBrowser::BreakpointListEntry methodsFor:'actions'!
browse
|browser|
browser := UserPreferences systemBrowserClass
openInClass:(Smalltalk classNamed:className) selector:selector.
lineNumber notNil ifTrue:[
browser codeView cursorLine:lineNumber col:1.
browser codeView selectLine:lineNumber.
].
!
method
^ (Smalltalk classNamed:className) compiledMethodAt:selector.
! !
!BreakpointBrowser::BreakpointListEntry methodsFor:'testing'!
isAssertion
^ type == #assertion
!
isCodeBreakpoint
^ type == #breakPoint
!
isDebugCode
^ type == #debugCode
!
isHalt
^ type == #halt
!
isMethodBreakpoint
^ type == #wrap
!
isOther
^ type == #other
! !
!BreakpointBrowser::MessageArgumentExtractor methodsFor:'accessing'!
callBack:something
callBack := something.
!
selectorToSearch:something
selectorToSearch := something.
! !
!BreakpointBrowser::MessageArgumentExtractor methodsFor:'visiting'!
acceptMessageNode: aMessageNode
|arg1Node arg1 arg2Node arg2 argument infoMessage|
aMessageNode selector == selectorToSearch ifTrue:[
aMessageNode arguments size > 0 ifTrue:[
arg1Node := aMessageNode arguments first.
arg1Node isLiteral ifTrue:[
arg1 := arg1Node value.
] ifFalse:[
arg1 := '(...)'.
].
aMessageNode arguments size > 1 ifTrue:[
arg2Node := aMessageNode arguments second.
arg2Node isLiteral ifTrue:[
arg2 := arg2Node value.
] ifFalse:[
arg2 := '(...)'.
].
].
].
selectorToSearch == #halt: ifTrue:[
infoMessage := arg1.
].
selectorToSearch == #breakPoint: ifTrue:[
argument := arg1.
].
selectorToSearch == #breakPoint:info: ifTrue:[
argument := arg1.
infoMessage := arg2.
].
selectorToSearch == #debuggingCodeFor:is: ifTrue:[
argument := arg1.
].
selectorToSearch == #assert: ifTrue:[
].
selectorToSearch == #assert:message: ifTrue:[
infoMessage := arg2.
].
callBack
value:aMessageNode firstLineNumber
value:argument
value:infoMessage
].
super acceptMessageNode: aMessageNode
! !
!BreakpointBrowser class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.29 2012-09-09 18:49:45 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.29 2012-09-09 18:49:45 cg Exp $'
! !
BreakpointBrowser initialize!