"
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 showAssertions showCodeBreakpoints
showCodeBreakpointsFor showMethodBreakpoints codeView infoHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk-Breakpoints'
!
Object subclass:#BreakpointListEntry
instanceVariableNames:'type 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:'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)
max: (Point 1024 768)
bounds: (Rectangle 0 0 680 691)
menu: mainMenu
)
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
)
)
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
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
label: '-'
)
(MenuItem
label: 'Code Breakpoints'
itemValue: showCodeBreakpoints:
translateLabel: true
hideMenuOnActivated: false
indication: showCodeBreakpoints
)
(MenuItem
enabled: showCodeBreakpoints
label: ' '
translateLabel: true
submenuChannel: codeBreakpointMenu
)
(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
indication: enableAssertions
)
(MenuItem
label: 'Halts'
itemValue: enableHalts:
translateLabel: true
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 XPToolbarIconLibrary reloadIcon)
)
(MenuItem
label: '-'
)
(MenuItem
enabled: hasSelectionHolder
label: 'Browse Selected Method'
itemValue: browseSelectedItem
translateLabel: true
isButton: true
labelImage: (ResourceRetriever XPToolbarIconLibrary startNewSystemBrowserIcon)
)
)
nil
nil
)
! !
!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
!
selectedBreakpointListEntry
^ 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 at:#IgnoreHalt ifAbsent:false) not
!
enableHalts:aBoolean
^ Smalltalk at:#IgnoreHalt put:aBoolean not
!
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"
!
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
!
showHalts
^ showHalts ? true
!
showHalts:aBoolean
showHalts := aBoolean.
self updateShownBreakpointList
!
showMethodBreakpoints
^ showMethodBreakpoints ? true
!
showMethodBreakpoints:aBoolean
showMethodBreakpoints := aBoolean.
self updateShownBreakpointList
! !
!BreakpointBrowser methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
"/ changedObject == toDoList ifTrue:[
"/ self updateShownToDoList.
"/ ^ self
"/ ].
!
filter
|newList|
newList := breakpointList.
self showHalts ifFalse:[
newList := newList reject:[:entry | entry isHalt].
].
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 showMethodBreakpoints ifFalse:[
newList := newList reject:[:entry | entry isMethodBreakpoint].
].
self showAssertions ifFalse:[
newList := newList reject:[:entry | entry isAssertion].
].
shownCopyOfBreakpointList contents:newList.
!
messageSelectors
^ (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:[
self updateForClass:(aParameter first) selector:(aParameter second).
^ self.
].
something == #methodInClassRemoved ifTrue:[
self updateForClass:(aParameter first) selector:(aParameter second).
^ self.
].
].
^ super update:something with:aParameter from:changedObject
"Created: / 18-02-2007 / 12:54:32 / cg"
!
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.
].
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
!
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|
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 := mthd parseTree.
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 |
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
Smalltalk removeDependent:self.
super release
! !
!BreakpointBrowser methodsFor:'menu actions'!
openAboutThisApplication
super openAboutThisApplication
!
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
].
!
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.
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 value:[:onOff |
(showCodeBreakpointsFor at:arg ifAbsentPut:[true asValue]) value:onOff.
self updateShownBreakpointList
].
menu addItem:menuItem.
].
menu findGuiResourcesIn:self.
^ menu
"Modified: / 27-03-2007 / 10:54:29 / 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.
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 value:[: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: / 27-03-2007 / 10:54:29 / cg"
! !
!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"
!
updateList
self updatingLabelShown value:true.
"/ cg: mhmh why is this needed ????
Delay waitForSeconds:0.1.
self windowGroup repairDamage.
self withWaitCursorDo:[
ActivityNotification handle:[:ex |
self infoHolder value:ex errorString.
self windowGroup processExposeEvents.
ex proceed.
] do:[
self updateBreakpointList.
self updateShownBreakpointList.
]
].
self updatingLabelShown value:false.
! !
!BreakpointBrowser::BreakpointListEntry methodsFor:'accessing'!
arg
^ arg
!
className
^ className
!
enabled
^ enabled
!
info
^ 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
!
isHalt
^ type == #halt
!
isMethodBreakpoint
^ type == #wrap
! !
!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.9 2008-10-21 22:17:41 cg Exp $'
! !