--- a/Tools__BreakpointBrowser.st Tue Oct 21 16:05:50 2008 +0200
+++ b/Tools__BreakpointBrowser.st Wed Oct 22 00:17:41 2008 +0200
@@ -17,7 +17,7 @@
instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
selectionIndexHolder currentSortColumn currentSortIsReverse
showHalts showAssertions showCodeBreakpoints
- showCodeBreakpointsFor showMethodBreakpoints codeView'
+ showCodeBreakpointsFor showMethodBreakpoints codeView infoHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-Smalltalk-Breakpoints'
@@ -138,6 +138,26 @@
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
+ )
+ )
+
+ )
+ )
)
)
@@ -719,6 +739,15 @@
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.
@@ -801,10 +830,48 @@
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
@@ -813,95 +880,16 @@
breakpointList removeAll.
newShowCodeBreakpointsFor := Dictionary new.
- messages := #(
- (#breakPoint: #breakPoint)
- (#breakPoint:info: #breakPoint)
- (#debuggingCodeFor:is: #debugCode)
- (#halt #halt)
- (#halt: #halt)
- (#assert: #assertion)
- (#assert:message: #assertion)
- ).
-
- messageSelectors := (messages collect:[:each | each first]) asSet.
+ messages := self messagesAndTypes.
+ messageSelectors := self messageSelectors.
update := [:cls :mthd :sel |
- |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.
- breakpointList add: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.
- 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.
- ]
- ].
- ].
- ].
+ self
+ withBreakpointListEntriesFor:mthd class:cls selector:sel
+ messages:messages
+ messageSelectors:messageSelectors
+ rememberingCodeBreakpointTypesIn:newShowCodeBreakpointsFor
+ do:[:newEntry | breakpointList add:newEntry ].
].
Smalltalk allClassesDo:[:cls |
@@ -917,26 +905,91 @@
!
updateCode
- |entry method|
+ |entry method class|
entry := self selectedBreakpointListEntry.
entry isNil ifTrue:[
- codeView contents:nil.
- ^ self
+ codeView contents:nil.
+ ^ self
].
method := entry method.
method isNil ifTrue:[
- codeView contents:'OOPS - no source found'.
+ 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 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
@@ -946,6 +999,90 @@
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'!
@@ -958,6 +1095,8 @@
currentSortColumn := #type.
currentSortIsReverse := false.
+
+ Smalltalk addDependent:self.
!
postBuildCodeView:aView
@@ -970,6 +1109,11 @@
self enqueueMessage:#updateList for:self arguments:#().
"Modified: / 18-02-2007 / 12:55:57 / cg"
+!
+
+release
+ Smalltalk removeDependent:self.
+ super release
! !
!BreakpointBrowser methodsFor:'menu actions'!
@@ -1176,8 +1320,14 @@
self windowGroup repairDamage.
self withWaitCursorDo:[
- self updateBreakpointList.
- self updateShownBreakpointList.
+ ActivityNotification handle:[:ex |
+ self infoHolder value:ex errorString.
+ self windowGroup processExposeEvents.
+ ex proceed.
+ ] do:[
+ self updateBreakpointList.
+ self updateShownBreakpointList.
+ ]
].
self updatingLabelShown value:false.
! !
@@ -1248,7 +1398,7 @@
!
isCodeBreakpoint
- ^ type == #breakpoint
+ ^ type == #breakPoint
!
isHalt
@@ -1279,11 +1429,15 @@
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 := '(...)'.
].
].
].
@@ -1318,5 +1472,5 @@
!BreakpointBrowser class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.8 2008-10-20 15:13:02 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.9 2008-10-21 22:17:41 cg Exp $'
! !