care for lazy methods when searching for senders;
added special menu to class-method-list;
show break/trace in class-method-list.
--- a/BrowserView.st Mon Mar 03 15:03:20 1997 +0100
+++ b/BrowserView.st Mon Mar 03 15:22:36 1997 +0100
@@ -349,7 +349,7 @@
]
"Created: 4.1.1997 / 13:54:00 / cg"
- "Modified: 8.1.1997 / 23:20:44 / cg"
+ "Modified: 3.3.1997 / 15:04:21 / cg"
!
refetchClass
@@ -4432,7 +4432,7 @@
list do:[:line |
self busyLabel:'writing: ' with:line.
- classString := self classFromClassMethodString:line.
+ classString := self classNameFromClassMethodString:line.
selectorString := self selectorFromClassMethodString:line.
cls := self findClassNamed:classString.
@@ -4466,13 +4466,70 @@
]
"Modified: 17.6.1996 / 16:51:11 / stefan"
- "Modified: 7.1.1997 / 23:02:28 / cg"
+ "Modified: 3.3.1997 / 15:11:20 / cg"
!
classMethodMenu
<resource: #keyboard ( #Cmds #Cmdi #Cmdg ) >
- |labels selectors shorties|
+ |labels selectors shorties specialMenu|
+
+ (currentMethod notNil
+ and:[currentMethod isWrapped]) ifTrue:[
+ labels := #(
+ 'inspect method'
+ '-'
+ 'remove break/trace'
+ ).
+
+ selectors := #(
+ methodInspect
+ nil
+ methodRemoveBreakOrTrace
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'inspect method'
+ '-'
+ 'breakpoint'
+ 'breakpoint in ...'
+ '-'
+ 'trace'
+ 'trace sender'
+ 'trace full walkback'
+ '-'
+ 'start timing'
+ 'start counting'
+ 'start mem usage'
+ ).
+
+ selectors := #(
+ methodInspect
+ nil
+ methodBreakPoint
+ methodBreakPointInProcess
+ nil
+ methodTrace
+ methodTraceSender
+ methodTraceFull
+ nil
+ methodStartTiming
+ methodStartCounting
+ methodStartMemoryUsage
+ ).
+ ].
+ specialMenu := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors.
+
+ device ctrlDown ifTrue:[
+ currentMethod isNil ifTrue:[
+ classMethodListView flash.
+ ^ nil
+ ].
+
+ ^ specialMenu
+ ].
labels := #(
'fileOut'
@@ -4545,7 +4602,7 @@
selectors:selectors
accelerators:shorties
- "Modified: 10.7.1996 / 12:46:07 / cg"
+ "Modified: 3.3.1997 / 14:53:36 / cg"
! !
!BrowserView methodsFor:'class-method stuff'!
@@ -4553,24 +4610,12 @@
classFromClassMethodString:aString
"helper for classMethod-list - extract class name from the string"
- |pos s|
-
- s := aString string withoutSpaces.
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- (s endsWith:')') ifTrue:[
- s := aString copyTo:(aString lastIndexOf:$()-1.
- s := s withoutSpaces.
- ].
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- pos := s lastIndexOf:(Character space).
- ^ s copyTo:(pos - 1)
-
- "Modified: 17.6.1996 / 17:06:59 / stefan"
- "Modified: 4.11.1996 / 23:56:52 / cg"
+ |classString|
+
+ classString := self classNameFromClassMethodString:aString.
+ ^ self findClassNamed:classString.
+
+ "Created: 3.3.1997 / 15:12:59 / cg"
!
classMethodSelection:lineNr
@@ -4579,7 +4624,7 @@
|cls string classString selectorString meta|
string := classMethodListView selectionValue string.
- classString := self classFromClassMethodString:string.
+ classString := self classNameFromClassMethodString:string.
selectorString := self selectorFromClassMethodString:string.
((classString ~= 'Metaclass') and:[classString endsWith:' class']) ifTrue:[
@@ -4611,7 +4656,31 @@
"Modified: 31.8.1995 / 11:56:02 / claus"
"Modified: 17.6.1996 / 16:51:28 / stefan"
- "Modified: 20.12.1996 / 15:40:29 / cg"
+ "Modified: 3.3.1997 / 15:11:44 / cg"
+!
+
+classNameFromClassMethodString:aString
+ "helper for classMethod-list - extract class name from the string"
+
+ |pos s|
+
+ s := aString string withoutSpaces.
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (s endsWith:')') ifTrue:[
+ s := aString copyTo:(aString lastIndexOf:$()-1.
+ s := s withoutSpaces.
+ ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ pos := s lastIndexOf:(Character space).
+ ^ s copyTo:(pos - 1)
+
+ "Modified: 17.6.1996 / 17:06:59 / stefan"
+ "Modified: 4.11.1996 / 23:56:52 / cg"
+ "Created: 3.3.1997 / 15:11:30 / cg"
!
selectorFromClassMethodString:aString
@@ -6191,10 +6260,20 @@
commonTraceHelperWith:aSelector
"install a break/trace or countPoint for the current method"
+ "/ not for unbound methods (i.e. obsolete)
+
+ currentMethod isNil ifTrue:[^ self].
+ currentMethod who isNil ifTrue:[
+ self warn:'method is no longer valid'.
+ ^ self
+ ].
+
currentMethod := MessageTracer perform:aSelector with:currentMethod.
Class withoutUpdatingChangesDo:[
currentClass changed:#methodTrap with:currentSelector.
]
+
+ "Modified: 3.3.1997 / 15:17:15 / cg"
!
commonTraceHelperWith:aSelector with:argument
@@ -7004,7 +7083,7 @@
classMethodListView notNil ifTrue:[
s := classMethodListView selectionValue string.
- clsName := self classFromClassMethodString:s.
+ clsName := self classNameFromClassMethodString:s.
sel := self selectorFromClassMethodString:s.
isMeta := false
].
@@ -7061,7 +7140,7 @@
SystemBrowser browseClass:(w methodClass) selector:(w methodSelector)
]
- "Modified: 1.11.1996 / 16:20:29 / cg"
+ "Modified: 3.3.1997 / 15:11:51 / cg"
!
methodStartCounting
@@ -7505,6 +7584,51 @@
"Modified: 15.7.1996 / 11:44:11 / cg"
!
+updateClassMethodListWithScroll:scroll keepSelection:keep
+ |newList selection|
+
+
+ newList := OrderedCollection new.
+ selection := classMethodListView selection.
+
+ "/ update the list, caring for traps.
+ classMethodListView list do:[:entry |
+ |cls sel mthd s icn|
+
+ cls := self classFromClassMethodString:entry string.
+ sel := self selectorFromClassMethodString:entry string.
+ mthd := cls compiledMethodAt:(sel asSymbol).
+ mthd isNil ifTrue:[
+ newList add:cls name , ' ' , sel , ' ?'
+ ] ifFalse:[
+ s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel).
+ mthd isWrapped ifTrue:[
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (MessageTracer isTrapped:mthd) ifTrue:[
+ icn := self stopIcon
+ ] ifFalse:[
+ icn := self traceIcon
+ ].
+ newList add:(LabelAndIcon icon:icn string:s)
+ ] ifFalse:[
+ newList add:s
+ ].
+ ].
+ classMethodListView setList:newList.
+ ].
+
+ classMethodListView setSelection:selection.
+
+ "Modified: 18.12.1995 / 22:54:04 / stefan"
+ "Created: 3.3.1997 / 15:10:15 / cg"
+ "Modified: 3.3.1997 / 15:14:55 / cg"
+!
+
updateMethodList
self updateMethodListWithScroll:true keepSelection:false
!
@@ -7551,11 +7675,16 @@
keep ifTrue:[
methodListView setSelection:selection.
- ]
- ]
+ ].
+ ^ self
+ ].
+
+ classMethodListView notNil ifTrue:[
+ self updateClassMethodListWithScroll:scroll keepSelection:keep
+ ].
"Modified: 18.12.1995 / 22:54:04 / stefan"
- "Modified: 23.10.1996 / 21:00:52 / cg"
+ "Modified: 3.3.1997 / 15:10:42 / cg"
! !
!BrowserView methodsFor:'misc'!
@@ -8066,7 +8195,7 @@
]
"Created: 11.11.1996 / 12:42:14 / cg"
- "Modified: 1.3.1997 / 13:26:50 / cg"
+ "Modified: 3.3.1997 / 14:47:16 / cg"
!
busyLabel:what with:someArgument
@@ -9633,6 +9762,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.274 1997-03-03 09:39:08 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.275 1997-03-03 14:22:36 cg Exp $'
! !
BrowserView initialize!
--- a/BrwsrView.st Mon Mar 03 15:03:20 1997 +0100
+++ b/BrwsrView.st Mon Mar 03 15:22:36 1997 +0100
@@ -349,7 +349,7 @@
]
"Created: 4.1.1997 / 13:54:00 / cg"
- "Modified: 8.1.1997 / 23:20:44 / cg"
+ "Modified: 3.3.1997 / 15:04:21 / cg"
!
refetchClass
@@ -4432,7 +4432,7 @@
list do:[:line |
self busyLabel:'writing: ' with:line.
- classString := self classFromClassMethodString:line.
+ classString := self classNameFromClassMethodString:line.
selectorString := self selectorFromClassMethodString:line.
cls := self findClassNamed:classString.
@@ -4466,13 +4466,70 @@
]
"Modified: 17.6.1996 / 16:51:11 / stefan"
- "Modified: 7.1.1997 / 23:02:28 / cg"
+ "Modified: 3.3.1997 / 15:11:20 / cg"
!
classMethodMenu
<resource: #keyboard ( #Cmds #Cmdi #Cmdg ) >
- |labels selectors shorties|
+ |labels selectors shorties specialMenu|
+
+ (currentMethod notNil
+ and:[currentMethod isWrapped]) ifTrue:[
+ labels := #(
+ 'inspect method'
+ '-'
+ 'remove break/trace'
+ ).
+
+ selectors := #(
+ methodInspect
+ nil
+ methodRemoveBreakOrTrace
+ ).
+ ] ifFalse:[
+ labels := #(
+ 'inspect method'
+ '-'
+ 'breakpoint'
+ 'breakpoint in ...'
+ '-'
+ 'trace'
+ 'trace sender'
+ 'trace full walkback'
+ '-'
+ 'start timing'
+ 'start counting'
+ 'start mem usage'
+ ).
+
+ selectors := #(
+ methodInspect
+ nil
+ methodBreakPoint
+ methodBreakPointInProcess
+ nil
+ methodTrace
+ methodTraceSender
+ methodTraceFull
+ nil
+ methodStartTiming
+ methodStartCounting
+ methodStartMemoryUsage
+ ).
+ ].
+ specialMenu := PopUpMenu
+ labels:(resources array:labels)
+ selectors:selectors.
+
+ device ctrlDown ifTrue:[
+ currentMethod isNil ifTrue:[
+ classMethodListView flash.
+ ^ nil
+ ].
+
+ ^ specialMenu
+ ].
labels := #(
'fileOut'
@@ -4545,7 +4602,7 @@
selectors:selectors
accelerators:shorties
- "Modified: 10.7.1996 / 12:46:07 / cg"
+ "Modified: 3.3.1997 / 14:53:36 / cg"
! !
!BrowserView methodsFor:'class-method stuff'!
@@ -4553,24 +4610,12 @@
classFromClassMethodString:aString
"helper for classMethod-list - extract class name from the string"
- |pos s|
-
- s := aString string withoutSpaces.
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- (s endsWith:')') ifTrue:[
- s := aString copyTo:(aString lastIndexOf:$()-1.
- s := s withoutSpaces.
- ].
- (s endsWith:' !!') ifTrue:[
- s := s copyWithoutLast:2
- ].
- pos := s lastIndexOf:(Character space).
- ^ s copyTo:(pos - 1)
-
- "Modified: 17.6.1996 / 17:06:59 / stefan"
- "Modified: 4.11.1996 / 23:56:52 / cg"
+ |classString|
+
+ classString := self classNameFromClassMethodString:aString.
+ ^ self findClassNamed:classString.
+
+ "Created: 3.3.1997 / 15:12:59 / cg"
!
classMethodSelection:lineNr
@@ -4579,7 +4624,7 @@
|cls string classString selectorString meta|
string := classMethodListView selectionValue string.
- classString := self classFromClassMethodString:string.
+ classString := self classNameFromClassMethodString:string.
selectorString := self selectorFromClassMethodString:string.
((classString ~= 'Metaclass') and:[classString endsWith:' class']) ifTrue:[
@@ -4611,7 +4656,31 @@
"Modified: 31.8.1995 / 11:56:02 / claus"
"Modified: 17.6.1996 / 16:51:28 / stefan"
- "Modified: 20.12.1996 / 15:40:29 / cg"
+ "Modified: 3.3.1997 / 15:11:44 / cg"
+!
+
+classNameFromClassMethodString:aString
+ "helper for classMethod-list - extract class name from the string"
+
+ |pos s|
+
+ s := aString string withoutSpaces.
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (s endsWith:')') ifTrue:[
+ s := aString copyTo:(aString lastIndexOf:$()-1.
+ s := s withoutSpaces.
+ ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ pos := s lastIndexOf:(Character space).
+ ^ s copyTo:(pos - 1)
+
+ "Modified: 17.6.1996 / 17:06:59 / stefan"
+ "Modified: 4.11.1996 / 23:56:52 / cg"
+ "Created: 3.3.1997 / 15:11:30 / cg"
!
selectorFromClassMethodString:aString
@@ -6191,10 +6260,20 @@
commonTraceHelperWith:aSelector
"install a break/trace or countPoint for the current method"
+ "/ not for unbound methods (i.e. obsolete)
+
+ currentMethod isNil ifTrue:[^ self].
+ currentMethod who isNil ifTrue:[
+ self warn:'method is no longer valid'.
+ ^ self
+ ].
+
currentMethod := MessageTracer perform:aSelector with:currentMethod.
Class withoutUpdatingChangesDo:[
currentClass changed:#methodTrap with:currentSelector.
]
+
+ "Modified: 3.3.1997 / 15:17:15 / cg"
!
commonTraceHelperWith:aSelector with:argument
@@ -7004,7 +7083,7 @@
classMethodListView notNil ifTrue:[
s := classMethodListView selectionValue string.
- clsName := self classFromClassMethodString:s.
+ clsName := self classNameFromClassMethodString:s.
sel := self selectorFromClassMethodString:s.
isMeta := false
].
@@ -7061,7 +7140,7 @@
SystemBrowser browseClass:(w methodClass) selector:(w methodSelector)
]
- "Modified: 1.11.1996 / 16:20:29 / cg"
+ "Modified: 3.3.1997 / 15:11:51 / cg"
!
methodStartCounting
@@ -7505,6 +7584,51 @@
"Modified: 15.7.1996 / 11:44:11 / cg"
!
+updateClassMethodListWithScroll:scroll keepSelection:keep
+ |newList selection|
+
+
+ newList := OrderedCollection new.
+ selection := classMethodListView selection.
+
+ "/ update the list, caring for traps.
+ classMethodListView list do:[:entry |
+ |cls sel mthd s icn|
+
+ cls := self classFromClassMethodString:entry string.
+ sel := self selectorFromClassMethodString:entry string.
+ mthd := cls compiledMethodAt:(sel asSymbol).
+ mthd isNil ifTrue:[
+ newList add:cls name , ' ' , sel , ' ?'
+ ] ifFalse:[
+ s := cls name , ' ' , (mthd printStringForBrowserWithSelector:sel).
+ mthd isWrapped ifTrue:[
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (s endsWith:' !!') ifTrue:[
+ s := s copyWithoutLast:2
+ ].
+ (MessageTracer isTrapped:mthd) ifTrue:[
+ icn := self stopIcon
+ ] ifFalse:[
+ icn := self traceIcon
+ ].
+ newList add:(LabelAndIcon icon:icn string:s)
+ ] ifFalse:[
+ newList add:s
+ ].
+ ].
+ classMethodListView setList:newList.
+ ].
+
+ classMethodListView setSelection:selection.
+
+ "Modified: 18.12.1995 / 22:54:04 / stefan"
+ "Created: 3.3.1997 / 15:10:15 / cg"
+ "Modified: 3.3.1997 / 15:14:55 / cg"
+!
+
updateMethodList
self updateMethodListWithScroll:true keepSelection:false
!
@@ -7551,11 +7675,16 @@
keep ifTrue:[
methodListView setSelection:selection.
- ]
- ]
+ ].
+ ^ self
+ ].
+
+ classMethodListView notNil ifTrue:[
+ self updateClassMethodListWithScroll:scroll keepSelection:keep
+ ].
"Modified: 18.12.1995 / 22:54:04 / stefan"
- "Modified: 23.10.1996 / 21:00:52 / cg"
+ "Modified: 3.3.1997 / 15:10:42 / cg"
! !
!BrowserView methodsFor:'misc'!
@@ -8066,7 +8195,7 @@
]
"Created: 11.11.1996 / 12:42:14 / cg"
- "Modified: 1.3.1997 / 13:26:50 / cg"
+ "Modified: 3.3.1997 / 14:47:16 / cg"
!
busyLabel:what with:someArgument
@@ -9633,6 +9762,6 @@
!BrowserView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.274 1997-03-03 09:39:08 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.275 1997-03-03 14:22:36 cg Exp $'
! !
BrowserView initialize!