--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/EvMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,65 @@
+'From Smalltalk/X, Version:1.4 on 19-Jul-91 at 18:34:01'!
+
+StandardSystemView subclass:#EventMonitor
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Demo'
+!
+
+EventMonitor comment:'
+like xev - show events.
+
+start with: EventMonitor start
+
+%W% %E%
+written spring 91 by claus
+'!
+
+!EventMonitor class methodsFor:'defaults'!
+
+defaultExtent
+ ^ 200 @ 200
+!
+
+defaultLabel
+ ^ 'Event Monitor'
+! !
+
+!EventMonitor methodsFor:'events'!
+
+keyPress:key x:x y:y
+ 'KeyPress x:' print. x print. ' y:' print. y print.
+ (key isMemberOf:Character) ifTrue:[
+ ' character key:' print. key print.
+ ' (' print. key asciiValue print. ')' print
+ ] ifFalse:[
+ ' symbolic key:' print. key print
+ ].
+
+ '' printNewline
+!
+
+buttonPress:button x:x y:y
+ 'buttonPress x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+!
+
+buttonRelease:button x:x y:y
+ 'buttonRelease x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+!
+
+buttonMotion:button x:x y:y
+ 'buttonMotion x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+! !
+
+!EventMonitor methodsFor:'realization'!
+
+initEvents
+ self enableKeyEvents.
+ self enableButtonEvents.
+ self enableMotionEvents.
+ self enableButtonMotionEvents
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/EventMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,65 @@
+'From Smalltalk/X, Version:1.4 on 19-Jul-91 at 18:34:01'!
+
+StandardSystemView subclass:#EventMonitor
+ instanceVariableNames:''
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Views-Demo'
+!
+
+EventMonitor comment:'
+like xev - show events.
+
+start with: EventMonitor start
+
+%W% %E%
+written spring 91 by claus
+'!
+
+!EventMonitor class methodsFor:'defaults'!
+
+defaultExtent
+ ^ 200 @ 200
+!
+
+defaultLabel
+ ^ 'Event Monitor'
+! !
+
+!EventMonitor methodsFor:'events'!
+
+keyPress:key x:x y:y
+ 'KeyPress x:' print. x print. ' y:' print. y print.
+ (key isMemberOf:Character) ifTrue:[
+ ' character key:' print. key print.
+ ' (' print. key asciiValue print. ')' print
+ ] ifFalse:[
+ ' symbolic key:' print. key print
+ ].
+
+ '' printNewline
+!
+
+buttonPress:button x:x y:y
+ 'buttonPress x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+!
+
+buttonRelease:button x:x y:y
+ 'buttonRelease x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+!
+
+buttonMotion:button x:x y:y
+ 'buttonMotion x:' print. x print. ' y:' print. y print.
+ ' button:' print. button printNewline
+! !
+
+!EventMonitor methodsFor:'realization'!
+
+initEvents
+ self enableKeyEvents.
+ self enableButtonEvents.
+ self enableMotionEvents.
+ self enableButtonMotionEvents
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MemMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,215 @@
+'From Smalltalk/X, Version:1.5 on 4-Sep-91 at 18:41:13'!
+
+StandardSystemView subclass:#MemoryMonitor
+ instanceVariableNames:'halted delay myBlock myProcess oldData newData sumData
+ index org max min prevStringLen
+ grey'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+MemoryMonitor comment:'
+Shows memory usage (oldspace + newspace). Stupid, but works.
+'!
+
+!MemoryMonitor class methodsFor:'startup'!
+
+start
+ |m|
+
+ m := self origin:0 @ 0 extent:(200 @ 100).
+
+ m label:'Memory Monitor'.
+ m icon:(Form fromFile:'Monitor.icon' resolution:100).
+ m minExtent:(100 @ 100).
+
+ m open.
+ ^ m
+
+ "MemoryMonitor start"
+! !
+
+!MemoryMonitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ halted := false.
+ delay := 0.5.
+ ProcessorScheduler isPureEventDriven ifTrue:[
+ myBlock := [self updateDisplay].
+ ].
+ oldData := Array new:1000.
+ newData := Array new:1000.
+ index := 1.
+ org := font widthOf:'9999999'.
+ max := ObjectMemory bytesUsed + 100000.
+ min := ObjectMemory bytesUsed.
+ prevStringLen := nil.
+ viewBackground := Black
+
+ "MemoryMonitor start"
+!
+
+realize
+ super realize.
+ self enableKeyEvents.
+ myBlock notNil ifTrue:[
+ Processor addTimedBlock:myBlock after:delay.
+ ] ifFalse:[
+ myProcess := [
+ |d|
+
+ [true] whileTrue:[
+ (Delay forSeconds:delay) wait.
+ self updateDisplay
+ ]
+ ] forkAt:4.
+ myProcess name:'monitor update'
+ ].
+ grey := Color grey on:device.
+! !
+
+!MemoryMonitor methodsFor:'destroying'!
+
+destroy
+ myBlock notNil ifTrue:[
+ Processor removeTimedBlock:myBlock.
+ ] ifFalse:[
+ myProcess terminate.
+ myProcess := nil
+ ].
+ super destroy
+! !
+
+!MemoryMonitor methodsFor:'drawing'!
+
+updateDisplay
+ "update picture; trigger next update"
+
+ |h hOld memUsed oldMemUsed newMemUsed x half scaleChange s thisStringLen|
+
+ realized ifFalse:[^ self].
+ oldMemUsed := ObjectMemory oldSpaceUsed.
+ newMemUsed := ObjectMemory newSpaceUsed.
+ memUsed := oldMemUsed + newMemUsed.
+ oldData at:index put:oldMemUsed.
+ newData at:index put:newMemUsed.
+
+ h := (memUsed - min) * height // (max - min).
+ hOld := (oldMemUsed - min) * height // (max - min).
+
+ x := index - 1 + org.
+
+ self paint:grey.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+
+ self paint:White.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
+
+ s := (memUsed // 1024) printString , 'k'.
+ thisStringLen := s size.
+ (thisStringLen ~~ prevStringLen) ifTrue:[
+ prevStringLen notNil ifTrue:[
+ self displayOpaqueString:' ' from:1 to:prevStringLen
+ x:0 y:(height // 2 + font ascent)
+ ]
+ ].
+
+ self paint:White on:Black.
+ self displayOpaqueString:s x:0 y:(height // 2 + font ascent).
+ prevStringLen := thisStringLen.
+
+ (index >= (width - org)) ifTrue:[
+ half := ((width - org) // 2) // 8 * 8.
+ oldData replaceFrom:1 to:half with:oldData startingAt:(half + 1).
+ newData replaceFrom:1 to:half with:newData startingAt:(half + 1).
+
+ self copyFrom:self x:(half + org) y:0
+ toX:org y:0
+ width:(width - org - half) height:height.
+ self clearRectangleX:(width - half "- org" "org + half") y:0 width:(width - org - half) height:height.
+ index := index - half
+ ] ifFalse:[
+ index := index + 1
+ ].
+
+ scaleChange := false.
+ (memUsed < min) ifTrue:[
+ min := memUsed.
+ scaleChange := true
+ ].
+ (memUsed > max) ifTrue:[
+ max := memUsed.
+ scaleChange := true
+ ].
+ scaleChange ifTrue:[
+ self clear.
+ self redraw
+ ].
+ myBlock notNil ifTrue:[
+ Processor addTimedBlock:myBlock after:delay
+ ].
+!
+
+redraw
+ "redraw data"
+
+ |h hOld memUsed oldMemUsed x half|
+
+ realized ifFalse:[^ self].
+ x := org.
+ 1 to:(index - 1) do:[:i |
+ oldMemUsed := (oldData at:i).
+ memUsed := oldMemUsed + (newData at:i).
+ h := (((memUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
+ hOld := (((oldMemUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
+
+ self paint:grey.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+
+ self paint:White.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
+ x := x + 1
+ ].
+ self paint:White.
+ self displayString:(((max // 1024) printString) , 'k') x:0 y:(font ascent).
+ self displayString:(((min // 1024) printString) , 'k') x:0 y:(height - font descent)
+! !
+
+!MemoryMonitor methodsFor:'events'!
+
+keyPress:key x:x y:y
+ key == $f ifTrue:[
+ delay := delay / 2
+ ].
+ key == $s ifTrue:[
+ delay := delay * 2
+ ]
+!
+
+sizeChanged
+ |nn no|
+
+ ((width - org) == oldData size) ifTrue:[^ self].
+ nn := Array new:width.
+ no := Array new:width.
+ (nn size > newData size) ifTrue:[
+ nn replaceFrom:1 to:(newData size) with:newData.
+ no replaceFrom:1 to:(oldData size) with:oldData
+ ] ifFalse:[
+ (index > nn size) ifTrue:[
+ nn replaceFrom:1 to:(nn size) with:newData
+ startingAt:(index - nn size + 1 ).
+ no replaceFrom:1 to:(no size) with:oldData
+ startingAt:(index - no size + 1 ).
+ index := newData size - 1
+ ] ifFalse:[
+ nn replaceFrom:1 to:(nn size) with:newData.
+ no replaceFrom:1 to:(no size) with:oldData
+ ]
+ ].
+ newData := nn.
+ oldData := no
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MemUsageV.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,184 @@
+StandardSystemView subclass:#MemoryUsageView
+ instanceVariableNames:'info list sortBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+!MemoryUsageView methodsFor:'realization'!
+
+realize
+ super realize.
+ self updateInfo.
+ self sortByClass.
+! !
+
+!MemoryUsageView methodsFor:'initialization'!
+
+initialize
+ |l helpView headLine|
+
+ super initialize.
+ self label:'Memory usage'.
+
+ headLine := 'class # of insts avg sz bytes %mem'.
+
+ l := Label in:self.
+ l origin:(0.0 @ 0.0) corner:(1.0 @ l height).
+ l borderWidth:0.
+ l label:headLine.
+ l adjust:#left.
+
+ self extent:((font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.
+
+ helpView := ScrollableView for:ListView in:self.
+ helpView origin:(0.0 @ l height)
+ extent:[width @ (height - l height - l margin)].
+
+ l origin:(helpView scrollBar width @ 0.0).
+
+ list := helpView scrolledView.
+ list origin:(0.0 @ 0.0) extent:(1.0 @ 1.0).
+
+ list middleButtonMenu:(PopUpMenu
+ labels:#(
+ 'by class'
+ 'by inst count'
+ 'by memory usage'
+ '-'
+ 'update'
+ )
+
+ selectors:#(sortByClass
+ sortByInstCount
+ sortByMemoryUsage
+ nil
+ update
+ )
+ receiver:self
+ for:list).
+
+ "MemoryUsageView start"
+! !
+
+!MemoryUsageView methodsFor:'menu actions'!
+
+sortByClass
+ self label:'Memory usage; by class'.
+ sortBlock := [:a :b | (a at:1) name < (b at:1) name].
+ self updateDisplay
+!
+
+sortByInstCount
+ self label:'Memory usage; by instance count'.
+ sortBlock := [:a :b | (a at:2) > (b at:2) ].
+ self updateDisplay
+!
+
+sortByMemoryUsage
+ self label:'Memory usage; by memory usage'.
+ sortBlock := [:a :b | (a at:3) > (b at:3)].
+ self updateDisplay
+!
+
+update
+ self updateInfo.
+ self updateDisplay
+! !
+
+!MemoryUsageView methodsFor:'private'!
+
+updateInfo
+ self cursor:Cursor wait.
+ list cursor:Cursor wait.
+
+ info := IdentityDictionary new:600.
+
+ "find all objects, collect stuff in info"
+
+ ObjectMemory allObjectsDo:[:o |
+ |i class|
+
+ o isBehavior ifTrue:[
+ o isMeta ifTrue:[
+ class := Metaclass
+ ] ifFalse:[
+ class := Class
+ ]
+ ] ifFalse:[
+ class := o class.
+ ].
+ (info includesKey:class) ifFalse:[
+ info at:class put:(Array with:class
+ with:1
+ with:(ObjectMemory sizeOf:o))
+ ] ifTrue:[
+ i := info at:class.
+ i at:2 put:((i at:2) + 1).
+ i at:3 put:((i at:3) + (ObjectMemory sizeOf:o))
+ ]
+ ].
+
+ self cursor:Cursor normal.
+ list cursor:Cursor normal.
+!
+
+updateDisplay
+ |classNames counts sumSizes percents avgSizes rawData l line allMemory overAllCount overAllAvgSize|
+
+ self cursor:Cursor wait.
+ list cursor:Cursor wait.
+
+ rawData := info asSortedCollection:sortBlock.
+
+ "this avoids getting a sorted collection in the collect: below"
+ rawData := rawData asArray.
+
+ classNames := rawData collect:[:i |
+ |cls|
+
+ cls := i at:1.
+ cls == Class ifTrue:[
+ '<all classes>'
+ ] ifFalse:[
+ cls == Metaclass ifTrue:[
+ '<all metaclasses>'
+ ] ifFalse:[
+ cls name
+ ]
+ ]
+ ].
+
+ counts := rawData collect:[:i | (i at:2) ].
+ sumSizes := rawData collect:[:i | (i at:3) ].
+ allMemory := ObjectMemory bytesUsed.
+ percents := sumSizes collect:[:sz | (sz / allMemory * 100 * 10) rounded / 10.0].
+ avgSizes := (1 to:sumSizes size) collect:[:i | (((sumSizes at:i) / (counts at:i)) * 10) rounded / 10.0].
+
+ l := OrderedCollection new.
+ 1 to:classNames size do:[:i |
+ line := (classNames at:i) printStringPaddedTo:30 with:Character space.
+ line := line , ((counts at:i) printStringLeftPaddedTo:10).
+ line := line , ((avgSizes at:i) printStringLeftPaddedTo:10).
+ line := line , ((sumSizes at:i) printStringLeftPaddedTo:10).
+ line := line , ((percents at:i) printStringLeftPaddedTo:7).
+ l add:line
+ ].
+
+ "add summary line"
+ overAllCount := counts inject:0 into:[:sum :this | sum + this].
+ overAllAvgSize := ((allMemory / overAllCount) * 10) rounded / 10.0.
+
+ l add:''.
+ line := 'all objects' printStringPaddedTo:30 with:Character space.
+ line := line , (overAllCount printStringLeftPaddedTo:10).
+ line := line , (overAllAvgSize printStringLeftPaddedTo:10).
+ line := line , (allMemory printStringLeftPaddedTo:10).
+ line := line , (100.0 printStringLeftPaddedTo:7).
+ l add:line.
+
+ list list:l.
+
+ self cursor:Cursor normal.
+ list cursor:Cursor normal.
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MemoryMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,215 @@
+'From Smalltalk/X, Version:1.5 on 4-Sep-91 at 18:41:13'!
+
+StandardSystemView subclass:#MemoryMonitor
+ instanceVariableNames:'halted delay myBlock myProcess oldData newData sumData
+ index org max min prevStringLen
+ grey'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+MemoryMonitor comment:'
+Shows memory usage (oldspace + newspace). Stupid, but works.
+'!
+
+!MemoryMonitor class methodsFor:'startup'!
+
+start
+ |m|
+
+ m := self origin:0 @ 0 extent:(200 @ 100).
+
+ m label:'Memory Monitor'.
+ m icon:(Form fromFile:'Monitor.icon' resolution:100).
+ m minExtent:(100 @ 100).
+
+ m open.
+ ^ m
+
+ "MemoryMonitor start"
+! !
+
+!MemoryMonitor methodsFor:'initialization'!
+
+initialize
+ super initialize.
+
+ halted := false.
+ delay := 0.5.
+ ProcessorScheduler isPureEventDriven ifTrue:[
+ myBlock := [self updateDisplay].
+ ].
+ oldData := Array new:1000.
+ newData := Array new:1000.
+ index := 1.
+ org := font widthOf:'9999999'.
+ max := ObjectMemory bytesUsed + 100000.
+ min := ObjectMemory bytesUsed.
+ prevStringLen := nil.
+ viewBackground := Black
+
+ "MemoryMonitor start"
+!
+
+realize
+ super realize.
+ self enableKeyEvents.
+ myBlock notNil ifTrue:[
+ Processor addTimedBlock:myBlock after:delay.
+ ] ifFalse:[
+ myProcess := [
+ |d|
+
+ [true] whileTrue:[
+ (Delay forSeconds:delay) wait.
+ self updateDisplay
+ ]
+ ] forkAt:4.
+ myProcess name:'monitor update'
+ ].
+ grey := Color grey on:device.
+! !
+
+!MemoryMonitor methodsFor:'destroying'!
+
+destroy
+ myBlock notNil ifTrue:[
+ Processor removeTimedBlock:myBlock.
+ ] ifFalse:[
+ myProcess terminate.
+ myProcess := nil
+ ].
+ super destroy
+! !
+
+!MemoryMonitor methodsFor:'drawing'!
+
+updateDisplay
+ "update picture; trigger next update"
+
+ |h hOld memUsed oldMemUsed newMemUsed x half scaleChange s thisStringLen|
+
+ realized ifFalse:[^ self].
+ oldMemUsed := ObjectMemory oldSpaceUsed.
+ newMemUsed := ObjectMemory newSpaceUsed.
+ memUsed := oldMemUsed + newMemUsed.
+ oldData at:index put:oldMemUsed.
+ newData at:index put:newMemUsed.
+
+ h := (memUsed - min) * height // (max - min).
+ hOld := (oldMemUsed - min) * height // (max - min).
+
+ x := index - 1 + org.
+
+ self paint:grey.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+
+ self paint:White.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
+
+ s := (memUsed // 1024) printString , 'k'.
+ thisStringLen := s size.
+ (thisStringLen ~~ prevStringLen) ifTrue:[
+ prevStringLen notNil ifTrue:[
+ self displayOpaqueString:' ' from:1 to:prevStringLen
+ x:0 y:(height // 2 + font ascent)
+ ]
+ ].
+
+ self paint:White on:Black.
+ self displayOpaqueString:s x:0 y:(height // 2 + font ascent).
+ prevStringLen := thisStringLen.
+
+ (index >= (width - org)) ifTrue:[
+ half := ((width - org) // 2) // 8 * 8.
+ oldData replaceFrom:1 to:half with:oldData startingAt:(half + 1).
+ newData replaceFrom:1 to:half with:newData startingAt:(half + 1).
+
+ self copyFrom:self x:(half + org) y:0
+ toX:org y:0
+ width:(width - org - half) height:height.
+ self clearRectangleX:(width - half "- org" "org + half") y:0 width:(width - org - half) height:height.
+ index := index - half
+ ] ifFalse:[
+ index := index + 1
+ ].
+
+ scaleChange := false.
+ (memUsed < min) ifTrue:[
+ min := memUsed.
+ scaleChange := true
+ ].
+ (memUsed > max) ifTrue:[
+ max := memUsed.
+ scaleChange := true
+ ].
+ scaleChange ifTrue:[
+ self clear.
+ self redraw
+ ].
+ myBlock notNil ifTrue:[
+ Processor addTimedBlock:myBlock after:delay
+ ].
+!
+
+redraw
+ "redraw data"
+
+ |h hOld memUsed oldMemUsed x half|
+
+ realized ifFalse:[^ self].
+ x := org.
+ 1 to:(index - 1) do:[:i |
+ oldMemUsed := (oldData at:i).
+ memUsed := oldMemUsed + (newData at:i).
+ h := (((memUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
+ hOld := (((oldMemUsed - min) asFloat / (max - min) asFloat) * height) asInteger.
+
+ self paint:grey.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - h).
+
+ self paint:White.
+ self displayLineFromX:x y:(height - 1) toX:x y:(height - 1 - hOld).
+ x := x + 1
+ ].
+ self paint:White.
+ self displayString:(((max // 1024) printString) , 'k') x:0 y:(font ascent).
+ self displayString:(((min // 1024) printString) , 'k') x:0 y:(height - font descent)
+! !
+
+!MemoryMonitor methodsFor:'events'!
+
+keyPress:key x:x y:y
+ key == $f ifTrue:[
+ delay := delay / 2
+ ].
+ key == $s ifTrue:[
+ delay := delay * 2
+ ]
+!
+
+sizeChanged
+ |nn no|
+
+ ((width - org) == oldData size) ifTrue:[^ self].
+ nn := Array new:width.
+ no := Array new:width.
+ (nn size > newData size) ifTrue:[
+ nn replaceFrom:1 to:(newData size) with:newData.
+ no replaceFrom:1 to:(oldData size) with:oldData
+ ] ifFalse:[
+ (index > nn size) ifTrue:[
+ nn replaceFrom:1 to:(nn size) with:newData
+ startingAt:(index - nn size + 1 ).
+ no replaceFrom:1 to:(no size) with:oldData
+ startingAt:(index - no size + 1 ).
+ index := newData size - 1
+ ] ifFalse:[
+ nn replaceFrom:1 to:(nn size) with:newData.
+ no replaceFrom:1 to:(no size) with:oldData
+ ]
+ ].
+ newData := nn.
+ oldData := no
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/MemoryUsageView.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,184 @@
+StandardSystemView subclass:#MemoryUsageView
+ instanceVariableNames:'info list sortBlock'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+!MemoryUsageView methodsFor:'realization'!
+
+realize
+ super realize.
+ self updateInfo.
+ self sortByClass.
+! !
+
+!MemoryUsageView methodsFor:'initialization'!
+
+initialize
+ |l helpView headLine|
+
+ super initialize.
+ self label:'Memory usage'.
+
+ headLine := 'class # of insts avg sz bytes %mem'.
+
+ l := Label in:self.
+ l origin:(0.0 @ 0.0) corner:(1.0 @ l height).
+ l borderWidth:0.
+ l label:headLine.
+ l adjust:#left.
+
+ self extent:((font widthOf:headLine) + (device horizontalPixelPerMillimeter * 15) rounded) @ self height.
+
+ helpView := ScrollableView for:ListView in:self.
+ helpView origin:(0.0 @ l height)
+ extent:[width @ (height - l height - l margin)].
+
+ l origin:(helpView scrollBar width @ 0.0).
+
+ list := helpView scrolledView.
+ list origin:(0.0 @ 0.0) extent:(1.0 @ 1.0).
+
+ list middleButtonMenu:(PopUpMenu
+ labels:#(
+ 'by class'
+ 'by inst count'
+ 'by memory usage'
+ '-'
+ 'update'
+ )
+
+ selectors:#(sortByClass
+ sortByInstCount
+ sortByMemoryUsage
+ nil
+ update
+ )
+ receiver:self
+ for:list).
+
+ "MemoryUsageView start"
+! !
+
+!MemoryUsageView methodsFor:'menu actions'!
+
+sortByClass
+ self label:'Memory usage; by class'.
+ sortBlock := [:a :b | (a at:1) name < (b at:1) name].
+ self updateDisplay
+!
+
+sortByInstCount
+ self label:'Memory usage; by instance count'.
+ sortBlock := [:a :b | (a at:2) > (b at:2) ].
+ self updateDisplay
+!
+
+sortByMemoryUsage
+ self label:'Memory usage; by memory usage'.
+ sortBlock := [:a :b | (a at:3) > (b at:3)].
+ self updateDisplay
+!
+
+update
+ self updateInfo.
+ self updateDisplay
+! !
+
+!MemoryUsageView methodsFor:'private'!
+
+updateInfo
+ self cursor:Cursor wait.
+ list cursor:Cursor wait.
+
+ info := IdentityDictionary new:600.
+
+ "find all objects, collect stuff in info"
+
+ ObjectMemory allObjectsDo:[:o |
+ |i class|
+
+ o isBehavior ifTrue:[
+ o isMeta ifTrue:[
+ class := Metaclass
+ ] ifFalse:[
+ class := Class
+ ]
+ ] ifFalse:[
+ class := o class.
+ ].
+ (info includesKey:class) ifFalse:[
+ info at:class put:(Array with:class
+ with:1
+ with:(ObjectMemory sizeOf:o))
+ ] ifTrue:[
+ i := info at:class.
+ i at:2 put:((i at:2) + 1).
+ i at:3 put:((i at:3) + (ObjectMemory sizeOf:o))
+ ]
+ ].
+
+ self cursor:Cursor normal.
+ list cursor:Cursor normal.
+!
+
+updateDisplay
+ |classNames counts sumSizes percents avgSizes rawData l line allMemory overAllCount overAllAvgSize|
+
+ self cursor:Cursor wait.
+ list cursor:Cursor wait.
+
+ rawData := info asSortedCollection:sortBlock.
+
+ "this avoids getting a sorted collection in the collect: below"
+ rawData := rawData asArray.
+
+ classNames := rawData collect:[:i |
+ |cls|
+
+ cls := i at:1.
+ cls == Class ifTrue:[
+ '<all classes>'
+ ] ifFalse:[
+ cls == Metaclass ifTrue:[
+ '<all metaclasses>'
+ ] ifFalse:[
+ cls name
+ ]
+ ]
+ ].
+
+ counts := rawData collect:[:i | (i at:2) ].
+ sumSizes := rawData collect:[:i | (i at:3) ].
+ allMemory := ObjectMemory bytesUsed.
+ percents := sumSizes collect:[:sz | (sz / allMemory * 100 * 10) rounded / 10.0].
+ avgSizes := (1 to:sumSizes size) collect:[:i | (((sumSizes at:i) / (counts at:i)) * 10) rounded / 10.0].
+
+ l := OrderedCollection new.
+ 1 to:classNames size do:[:i |
+ line := (classNames at:i) printStringPaddedTo:30 with:Character space.
+ line := line , ((counts at:i) printStringLeftPaddedTo:10).
+ line := line , ((avgSizes at:i) printStringLeftPaddedTo:10).
+ line := line , ((sumSizes at:i) printStringLeftPaddedTo:10).
+ line := line , ((percents at:i) printStringLeftPaddedTo:7).
+ l add:line
+ ].
+
+ "add summary line"
+ overAllCount := counts inject:0 into:[:sum :this | sum + this].
+ overAllAvgSize := ((allMemory / overAllCount) * 10) rounded / 10.0.
+
+ l add:''.
+ line := 'all objects' printStringPaddedTo:30 with:Character space.
+ line := line , (overAllCount printStringLeftPaddedTo:10).
+ line := line , (overAllAvgSize printStringLeftPaddedTo:10).
+ line := line , (allMemory printStringLeftPaddedTo:10).
+ line := line , (100.0 printStringLeftPaddedTo:7).
+ l add:line.
+
+ list list:l.
+
+ self cursor:Cursor normal.
+ list cursor:Cursor normal.
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ProcMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,264 @@
+StandardSystemView subclass:#ProcessMonitor
+ instanceVariableNames:'listView processes listUpdateDelay updateDelay runnableColor suspendedColor
+ updateBlock listUpdateBlock updateProcess'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+ProcessMonitor comment:'
+'!
+
+!ProcessMonitor class methodsFor:'startup'!
+
+start
+ |m|
+
+ m := self new.
+ m label:'Process Monitor'.
+ m icon:(Form fromFile:'PMonitor.icon' resolution:100).
+ m minExtent:(100 @ 100).
+
+ m open.
+ ^ m
+
+ "ProcessMonitor start"
+! !
+
+!ProcessMonitor methodsFor:'initialization'!
+
+initialize
+ |v|
+
+ super initialize.
+
+ self extent:(font widthOf:'name/id state prio usedStack maxStack')
+ + 40 @
+ 100.
+
+ v := ScrollableView for:SelectionInListView in:self.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ listView := v scrolledView.
+ listView font:font.
+ listView middleButtonMenu:(PopUpMenu
+ labels:#(
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'terminate'
+ )
+ selectors:#(inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ terminateProcess
+ )
+ receiver:self
+ for:listView).
+ listView multipleSelectOk:true.
+ listView keyboardHandler:self.
+
+ updateDelay := 0.5.
+ listUpdateDelay := 5.
+ true "ProcessorScheduler isPureEventDriven" ifTrue:[
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
+ ].
+ viewBackground := Black.
+ device hasColors ifTrue:[
+ runnableColor := Color green.
+ suspendedColor := Color red.
+ ] ifFalse:[
+ runnableColor := suspendedColor := Color white
+ ]
+
+ "ProcessMonitor start"
+!
+
+realize
+ super realize.
+ self enableKeyEvents.
+ self updateList.
+ self updateStatus.
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay.
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay.
+ ] ifFalse:[
+ updateProcess := [
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList
+ ]
+ ] forkAt:9.
+ updateProcess name:'process update'.
+ ].
+ runnableColor := runnableColor on:device.
+ suspendedColor := suspendedColor on:device.
+! !
+
+!ProcessMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
+ ] ifFalse:[
+ updateProcess terminate
+ ].
+ super destroy
+! !
+
+!ProcessMonitor methodsFor:'menu actions'!
+
+selectedProcessesDo:aBlock
+ |p nr|
+
+ (listView selection isKindOf:Collection) ifTrue:[
+ listView selection do:[:n |
+ nr := n - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ nr := listView selection - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ].
+!
+
+debugProcess
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+inspectProcess
+ self selectedProcessesDo:[:p |
+ p inspect
+ ]
+!
+
+terminateProcess
+ self selectedProcessesDo:[:p |
+ p terminate
+ ]
+!
+
+resumeProcess
+ self selectedProcessesDo:[:p |
+ p resume
+ ]
+!
+
+suspendProcess
+ self selectedProcessesDo:[:p |
+ p suspend
+ ]
+! !
+
+!ProcessMonitor methodsFor:'events'!
+
+canHandle:key
+ ^ key == #InspectIt
+!
+
+keyPress:key x:x y:y
+ key == #InspectIt ifTrue:[
+ ^ self inspectProcess.
+ ].
+ ^ super keyPress:key x:x y:y
+! !
+
+!ProcessMonitor methodsFor:'drawing'!
+
+updateList
+ "update list of processes"
+
+ |newList|
+
+ newList := Process allInstances.
+ "sort by id - take core of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
+
+ id1 := p1 id.
+ id2 := p2 id.
+ id1 isNil ifTrue:[true]
+ ifFalse:[
+ id2 isNil ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay
+ ].
+!
+
+updateStatus
+ "update status display of processes"
+
+ |oldList list line|
+
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:'name/id state prio usedStack maxStack'.
+ list add:'-------------------------------------------------------------------'.
+
+ processes do:[:aProcess |
+ |nm|
+
+ aProcess notNil ifTrue:[
+ nm := aProcess nameOrId.
+ nm size > 27 ifTrue:[
+ line := (nm copyTo:27) , ' '
+ ] ifFalse:[
+ line := aProcess nameOrId printStringPaddedTo:28.
+ ].
+ line := line , (aProcess state printStringPaddedTo:12).
+ line := line , (aProcess priority printStringLeftPaddedTo:4).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ list add:line
+ ].
+ ].
+ ].
+ list ~= oldList ifTrue:[
+ "avoid flicker"
+ oldList size == list size ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ ]
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay
+ ]
+! !
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/ProcessMonitor.st Sat Jan 08 18:39:17 1994 +0100
@@ -0,0 +1,264 @@
+StandardSystemView subclass:#ProcessMonitor
+ instanceVariableNames:'listView processes listUpdateDelay updateDelay runnableColor suspendedColor
+ updateBlock listUpdateBlock updateProcess'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Debugger'
+!
+
+ProcessMonitor comment:'
+'!
+
+!ProcessMonitor class methodsFor:'startup'!
+
+start
+ |m|
+
+ m := self new.
+ m label:'Process Monitor'.
+ m icon:(Form fromFile:'PMonitor.icon' resolution:100).
+ m minExtent:(100 @ 100).
+
+ m open.
+ ^ m
+
+ "ProcessMonitor start"
+! !
+
+!ProcessMonitor methodsFor:'initialization'!
+
+initialize
+ |v|
+
+ super initialize.
+
+ self extent:(font widthOf:'name/id state prio usedStack maxStack')
+ + 40 @
+ 100.
+
+ v := ScrollableView for:SelectionInListView in:self.
+ v origin:0.0@0.0 corner:1.0@1.0.
+ listView := v scrolledView.
+ listView font:font.
+ listView middleButtonMenu:(PopUpMenu
+ labels:#(
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'terminate'
+ )
+ selectors:#(inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ terminateProcess
+ )
+ receiver:self
+ for:listView).
+ listView multipleSelectOk:true.
+ listView keyboardHandler:self.
+
+ updateDelay := 0.5.
+ listUpdateDelay := 5.
+ true "ProcessorScheduler isPureEventDriven" ifTrue:[
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
+ ].
+ viewBackground := Black.
+ device hasColors ifTrue:[
+ runnableColor := Color green.
+ suspendedColor := Color red.
+ ] ifFalse:[
+ runnableColor := suspendedColor := Color white
+ ]
+
+ "ProcessMonitor start"
+!
+
+realize
+ super realize.
+ self enableKeyEvents.
+ self updateList.
+ self updateStatus.
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay.
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay.
+ ] ifFalse:[
+ updateProcess := [
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList
+ ]
+ ] forkAt:9.
+ updateProcess name:'process update'.
+ ].
+ runnableColor := runnableColor on:device.
+ suspendedColor := suspendedColor on:device.
+! !
+
+!ProcessMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
+ ] ifFalse:[
+ updateProcess terminate
+ ].
+ super destroy
+! !
+
+!ProcessMonitor methodsFor:'menu actions'!
+
+selectedProcessesDo:aBlock
+ |p nr|
+
+ (listView selection isKindOf:Collection) ifTrue:[
+ listView selection do:[:n |
+ nr := n - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
+ ] ifFalse:[
+ nr := listView selection - 2.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ].
+!
+
+debugProcess
+ self selectedProcessesDo:[:p |
+ Debugger openOn:p
+ ]
+!
+
+inspectProcess
+ self selectedProcessesDo:[:p |
+ p inspect
+ ]
+!
+
+terminateProcess
+ self selectedProcessesDo:[:p |
+ p terminate
+ ]
+!
+
+resumeProcess
+ self selectedProcessesDo:[:p |
+ p resume
+ ]
+!
+
+suspendProcess
+ self selectedProcessesDo:[:p |
+ p suspend
+ ]
+! !
+
+!ProcessMonitor methodsFor:'events'!
+
+canHandle:key
+ ^ key == #InspectIt
+!
+
+keyPress:key x:x y:y
+ key == #InspectIt ifTrue:[
+ ^ self inspectProcess.
+ ].
+ ^ super keyPress:key x:x y:y
+! !
+
+!ProcessMonitor methodsFor:'drawing'!
+
+updateList
+ "update list of processes"
+
+ |newList|
+
+ newList := Process allInstances.
+ "sort by id - take core of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
+
+ id1 := p1 id.
+ id2 := p2 id.
+ id1 isNil ifTrue:[true]
+ ifFalse:[
+ id2 isNil ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:listUpdateBlock after:listUpdateDelay
+ ].
+!
+
+updateStatus
+ "update status display of processes"
+
+ |oldList list line|
+
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:'name/id state prio usedStack maxStack'.
+ list add:'-------------------------------------------------------------------'.
+
+ processes do:[:aProcess |
+ |nm|
+
+ aProcess notNil ifTrue:[
+ nm := aProcess nameOrId.
+ nm size > 27 ifTrue:[
+ line := (nm copyTo:27) , ' '
+ ] ifFalse:[
+ line := aProcess nameOrId printStringPaddedTo:28.
+ ].
+ line := line , (aProcess state printStringPaddedTo:12).
+ line := line , (aProcess priority printStringLeftPaddedTo:4).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ list add:line
+ ].
+ ].
+ ].
+ list ~= oldList ifTrue:[
+ "avoid flicker"
+ oldList size == list size ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ ]
+ ].
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock after:updateDelay
+ ]
+! !