--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__BreakpointBrowser.st Wed Aug 20 21:38:52 2008 +0200
@@ -0,0 +1,1197 @@
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+ApplicationModel subclass:#BreakpointBrowser
+ instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
+ selectionIndexHolder currentSortColumn currentSortIsReverse
+ showHalts showAssertions showCodeBreakpoints
+ showCodeBreakpointsFor showMethodBreakpoints codeView'
+ 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'!
+
+documentation
+"
+ documentation to be added.
+
+ [author:]
+ cg (cg@FUSI)
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+!
+
+examples
+"
+ Starting the application:
+ [exBegin]
+ BreakpointBrowser open
+
+ [exEnd]
+
+ more examples to be added:
+ [exBegin]
+ ... add code fragment for
+ ... executable example here ...
+ [exEnd]
+"
+! !
+
+!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...'
+ name: 'Label1'
+ layout: (LayoutFrame 0 0 32 0 0 1 0 1)
+ visibilityChannel: updatingLabelShown
+ translateLabel: true
+ )
+ )
+
+ )
+ )
+! !
+
+!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: browseItem
+ 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: '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: 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_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
+ )
+ )
+! !
+
+!BreakpointBrowser methodsFor:'accessing'!
+
+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
+!
+
+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.
+!
+
+update:something with:aParameter from:changedObject
+ ^ super update:something with:aParameter from:changedObject
+
+ "Created: / 18-02-2007 / 12:54:32 / cg"
+!
+
+updateBreakpointList
+ |newShowCodeBreakpointsFor messages update |
+
+ breakpointList removeAll.
+ newShowCodeBreakpointsFor := Dictionary new.
+
+ messages := #(
+ (#breakPoint: #breakpoint)
+ (#breakPoint:info: #breakpoint)
+ (#halt #halt)
+ (#halt: #halt)
+ (#assert: #assertion)
+ (#assert:message: #assertion)
+ ).
+
+ update := [:cls :mthd :sel |
+ |entry type|
+
+ 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.
+ breakpointList add:entry.
+ ].
+
+ messages pairsDo:[:bpSel :type|
+ |tree extractor|
+
+ (mthd sends: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.
+ breakpointList add: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.
+ breakpointList add:entry.
+ ].
+ tree acceptVisitor:extractor.
+ ]
+ ].
+ ].
+ ].
+
+ 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|
+
+ 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.
+ ].
+ ].
+
+
+
+!
+
+updateShownBreakpointList
+
+ self shownCopyOfBreakpointList contents:breakpointList.
+ self filter.
+ self resort.
+
+
+! !
+
+!BreakpointBrowser methodsFor:'initialization & release'!
+
+initialize
+ super initialize.
+
+ showCodeBreakpointsFor := Dictionary new.
+ breakpointList := List new.
+
+ currentSortColumn := #type.
+ currentSortIsReverse := false.
+!
+
+postBuildCodeView:aView
+ codeView := aView
+!
+
+postOpenWith:aBuilder
+ super postOpenWith:aBuilder.
+
+ self enqueueMessage:#updateList for:self arguments:#().
+
+ "Modified: / 18-02-2007 / 12:55:57 / cg"
+! !
+
+!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 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"
+!
+
+removeItems:entriesToRemove
+ entriesToRemove do:[:entryToRemove |
+ toDoList remove:entryToRemove
+ ].
+! !
+
+!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 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:[
+ 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.
+ ].
+ aMessageNode arguments size > 1 ifTrue:[
+ arg2Node := aMessageNode arguments second.
+ arg2Node isLiteral ifTrue:[
+ arg2 := arg2Node value.
+ ].
+ ].
+ ].
+
+ selectorToSearch == #halt: ifTrue:[
+ infoMessage := arg1.
+ ].
+ selectorToSearch == #breakPoint: ifTrue:[
+ argument := arg1.
+ ].
+ selectorToSearch == #breakPoint:info: ifTrue:[
+ argument := arg1.
+ infoMessage := arg2.
+ ].
+ 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.1 2008-08-20 19:38:52 cg Exp $'
+! !