author | Jan Vrany <jan.vrany@fit.cvut.cz> |
Sun, 05 Feb 2012 01:49:41 +0000 | |
branch | jv |
changeset 12144 | 18c25ec50d96 |
parent 12128 | a7ff7d66ee85 |
child 12287 | 400a99059170 |
permissions | -rw-r--r-- |
" 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]) asSet. ! 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; value:[ 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 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. menu addItem:( MenuItem new label:'Toggle All'; translateLabel:true; hideMenuOnActivated:false; value:[ 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 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-10-2010 / 13:36:28 / 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 ^ '$Id: Tools__BreakpointBrowser.st 7854 2012-01-30 17:49:41Z vranyj1 $' ! version_CVS ^ '§Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.27 2012/01/27 10:52:11 cg Exp §' ! version_SVN ^ '$Id: Tools__BreakpointBrowser.st 7854 2012-01-30 17:49:41Z vranyj1 $' ! ! BreakpointBrowser initialize!