--- a/BrowserView.st Sat Mar 25 23:23:29 1995 +0100
+++ b/BrowserView.st Sat Mar 25 23:24:57 1995 +0100
@@ -29,7 +29,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.3 1995-03-18 05:18:05 claus Exp $
+$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.4 1995-03-25 22:23:42 claus Exp $
'!
!BrowserView class methodsFor:'documentation'!
@@ -50,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.3 1995-03-18 05:18:05 claus Exp $
+$Header: /cvs/stx/stx/libtool/BrowserView.st,v 1.4 1995-03-25 22:23:42 claus Exp $
"
!
@@ -101,6 +101,12 @@
!BrowserView methodsFor:'misc'!
+processName
+ "the name of my process - for the processMonitor only"
+
+ ^ 'System Browser'.
+!
+
updateCodeView
|code|
@@ -4249,6 +4255,7 @@
'find method ...'
'-'
'new category ...'
+ 'copy category ...'
'create access methods'
).
selectors := #(
@@ -4256,6 +4263,7 @@
methodCategoryFindAnyMethod
nil
methodCategoryNewCategory
+ methodCategoryCopyCategory
methodCategoryCreateAccessMethods
).
] ifFalse:[
--- a/BrwsrView.st Sat Mar 25 23:23:29 1995 +0100
+++ b/BrwsrView.st Sat Mar 25 23:24:57 1995 +0100
@@ -29,7 +29,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.3 1995-03-18 05:18:05 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.4 1995-03-25 22:23:42 claus Exp $
'!
!BrowserView class methodsFor:'documentation'!
@@ -50,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.3 1995-03-18 05:18:05 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/BrwsrView.st,v 1.4 1995-03-25 22:23:42 claus Exp $
"
!
@@ -101,6 +101,12 @@
!BrowserView methodsFor:'misc'!
+processName
+ "the name of my process - for the processMonitor only"
+
+ ^ 'System Browser'.
+!
+
updateCodeView
|code|
@@ -4249,6 +4255,7 @@
'find method ...'
'-'
'new category ...'
+ 'copy category ...'
'create access methods'
).
selectors := #(
@@ -4256,6 +4263,7 @@
methodCategoryFindAnyMethod
nil
methodCategoryNewCategory
+ methodCategoryCopyCategory
methodCategoryCreateAccessMethods
).
] ifFalse:[
--- a/FBrowser.st Sat Mar 25 23:23:29 1995 +0100
+++ b/FBrowser.st Sat Mar 25 23:24:57 1995 +0100
@@ -29,7 +29,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.33 1995-03-09 03:31:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.34 1995-03-25 22:24:10 claus Exp $
'!
!FileBrowser class methodsFor:'documentation'!
@@ -50,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.33 1995-03-09 03:31:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/FBrowser.st,v 1.34 1995-03-25 22:24:10 claus Exp $
"
!
@@ -185,7 +185,7 @@
].
labelView adjust:#right.
labelView borderWidth:0.
- labelView model:self; menu:#labelMenu.
+ labelView model:self; menu:#labelMenu; aspect:#path.
labelFrame model:self; menu:#labelMenu.
killButton := Button label:(resources string:'kill') in:self.
@@ -244,6 +244,11 @@
"set the directory to be browsed"
currentDirectory := FileDirectory directoryNamed:aDirectoryPath.
+ self changed:#path.
+ "
+ tell my subview (whatever that is) to start its file-dialog
+ (i.e. save-as etc.) in that directory
+ "
(subView respondsTo:#directoryForFileDialog:) ifTrue:[
subView directoryForFileDialog:currentDirectory
]
@@ -255,6 +260,15 @@
^ Array with:filterField with:fileListView with:subView
! !
+!FileBrowser methodsFor:'queries'!
+
+path
+ "return my currentDirectories pathName;
+ sent from the pathField label to aquire pathname when I changed directory"
+
+ ^ currentDirectory pathName
+! !
+
!FileBrowser methodsFor:'events'!
mapped
@@ -623,7 +637,6 @@
self withCursor:(Cursor read) do:[
Processor removeTimedBlock:checkBlock.
- labelView label:(currentDirectory pathName).
timeOfLastCheck := AbsoluteTime now.
files := currentDirectory asOrderedCollection.
@@ -784,10 +797,6 @@
path := currentDirectory pathName.
previousDirectory := path.
- (labelView notNil
- and:[labelView middleButtonMenu notNil]) ifTrue:[
- labelView middleButtonMenu enable:#changeToPreviousDirectory.
- ].
"
remember where we are in the fileList
@@ -882,19 +891,12 @@
(currentDirectory isDirectory:aPathName) ifTrue:[
newDirectory := FileDirectory directoryNamed:aPathName in:currentDirectory.
newDirectory notNil ifTrue:[
- currentDirectory := newDirectory.
+ self currentDirectory:newDirectory pathName.
fileListView contents:nil.
currentFileName := nil.
self updateCurrentDirectory.
info := self getInfoFile.
self showInfo:info.
- "
- tell my subview (whatever that is) to start its file-dialog
- (i.e. save-as etc.) in that directory
- "
- (subView respondsTo:#directoryForFileDialog:) ifTrue:[
- subView directoryForFileDialog:currentDirectory
- ]
]
]
!
@@ -1213,7 +1215,8 @@
stream := PipeStream readingFrom:('cd '
, currentDirectory pathName
, '; '
- , command).
+ , command
+ , ' 2>&1' ).
stream notNil ifTrue:[
"
this can be a time consuming operation; therefore lower my priority
@@ -1724,10 +1727,12 @@
labels:#(
'Changes browser'
'Editor '
+ 'Image inspect '
)
selectors:#(
openChangesBrowser
openEditor
+ openImageInspector
)
receiver:self).
^m
@@ -1793,6 +1798,10 @@
self openTool:EditTextView
!
+openImageInspector
+ self openTool:ImageEditView
+!
+
fileSelect:lineNr
"selected a file - do nothing here"
^ self
--- a/FileBrowser.st Sat Mar 25 23:23:29 1995 +0100
+++ b/FileBrowser.st Sat Mar 25 23:24:57 1995 +0100
@@ -29,7 +29,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.33 1995-03-09 03:31:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.34 1995-03-25 22:24:10 claus Exp $
'!
!FileBrowser class methodsFor:'documentation'!
@@ -50,7 +50,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.33 1995-03-09 03:31:04 claus Exp $
+$Header: /cvs/stx/stx/libtool/FileBrowser.st,v 1.34 1995-03-25 22:24:10 claus Exp $
"
!
@@ -185,7 +185,7 @@
].
labelView adjust:#right.
labelView borderWidth:0.
- labelView model:self; menu:#labelMenu.
+ labelView model:self; menu:#labelMenu; aspect:#path.
labelFrame model:self; menu:#labelMenu.
killButton := Button label:(resources string:'kill') in:self.
@@ -244,6 +244,11 @@
"set the directory to be browsed"
currentDirectory := FileDirectory directoryNamed:aDirectoryPath.
+ self changed:#path.
+ "
+ tell my subview (whatever that is) to start its file-dialog
+ (i.e. save-as etc.) in that directory
+ "
(subView respondsTo:#directoryForFileDialog:) ifTrue:[
subView directoryForFileDialog:currentDirectory
]
@@ -255,6 +260,15 @@
^ Array with:filterField with:fileListView with:subView
! !
+!FileBrowser methodsFor:'queries'!
+
+path
+ "return my currentDirectories pathName;
+ sent from the pathField label to aquire pathname when I changed directory"
+
+ ^ currentDirectory pathName
+! !
+
!FileBrowser methodsFor:'events'!
mapped
@@ -623,7 +637,6 @@
self withCursor:(Cursor read) do:[
Processor removeTimedBlock:checkBlock.
- labelView label:(currentDirectory pathName).
timeOfLastCheck := AbsoluteTime now.
files := currentDirectory asOrderedCollection.
@@ -784,10 +797,6 @@
path := currentDirectory pathName.
previousDirectory := path.
- (labelView notNil
- and:[labelView middleButtonMenu notNil]) ifTrue:[
- labelView middleButtonMenu enable:#changeToPreviousDirectory.
- ].
"
remember where we are in the fileList
@@ -882,19 +891,12 @@
(currentDirectory isDirectory:aPathName) ifTrue:[
newDirectory := FileDirectory directoryNamed:aPathName in:currentDirectory.
newDirectory notNil ifTrue:[
- currentDirectory := newDirectory.
+ self currentDirectory:newDirectory pathName.
fileListView contents:nil.
currentFileName := nil.
self updateCurrentDirectory.
info := self getInfoFile.
self showInfo:info.
- "
- tell my subview (whatever that is) to start its file-dialog
- (i.e. save-as etc.) in that directory
- "
- (subView respondsTo:#directoryForFileDialog:) ifTrue:[
- subView directoryForFileDialog:currentDirectory
- ]
]
]
!
@@ -1213,7 +1215,8 @@
stream := PipeStream readingFrom:('cd '
, currentDirectory pathName
, '; '
- , command).
+ , command
+ , ' 2>&1' ).
stream notNil ifTrue:[
"
this can be a time consuming operation; therefore lower my priority
@@ -1724,10 +1727,12 @@
labels:#(
'Changes browser'
'Editor '
+ 'Image inspect '
)
selectors:#(
openChangesBrowser
openEditor
+ openImageInspector
)
receiver:self).
^m
@@ -1793,6 +1798,10 @@
self openTool:EditTextView
!
+openImageInspector
+ self openTool:ImageEditView
+!
+
fileSelect:lineNr
"selected a file - do nothing here"
^ self
--- a/Make.proto Sat Mar 25 23:23:29 1995 +0100
+++ b/Make.proto Sat Mar 25 23:24:57 1995 +0100
@@ -19,13 +19,17 @@
STCOPT=$(LIBTOOL_STCOPT)
STCLOCALOPT=-Pprogramming-tools $(COMMONSYMBOLS)
+RCSSOURCES=*.st Make.proto resources/*.rs
+
all:: abbrev.stc objs classList.stc $(OBJTARGET)
objs:: \
+ AboutBox.$(O) \
$(SBROWSER_OBJ) \
$(CBROWSER_OBJ) \
DebugView.$(O) \
Launcher.$(O) \
+ NewLauncher.$(O) \
InspView.$(O) \
DictInspV.$(O) \
ConInspV.$(O) \
@@ -68,14 +72,15 @@
libtool/.dir.info \
libtool/Make.proto \
libtool/*.st \
- libtool/resources \
+ libtool/resources/.dir.info \
+ libtool/resources/*.rs \
libtool/bitmaps)
#
# special BIG-rule (kludge for HP)
#
#SBrowser.$(O):
-# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=SBrowser
+# $(MAKE) $(BIG_STFILE_RULE) BIG_FILE=SBrowser
BrwsrView.$(O):
$(MAKE) $(BIG_STFILE_RULE) BIG_FILE=BrwsrView
@@ -87,7 +92,10 @@
OBJECT=$(I)/Object.H $(I)/stc.h $(I)/stcIntern.h $(CPUINTERN_H)
VIEW=$(I)/View.H $(OBJECT)
STDSYSVIEW=$(I)/StdSysV.H $(VIEW)
+INFOBOX=$(I)/InfoBox.H $(I)/DialogBox.H $(I)/ModalBox.H
+
MODEL=$(I)/Model.H $(OBJECT)
+APPMODEL=$(I)/AppModel.H $(MODEL)
InspView.$(O): InspView.st $(VIEW)
DictInspV.$(O): DictInspV.st $(I)/InspView.H $(VIEW)
@@ -96,8 +104,9 @@
DebugView.$(O): DebugView.st $(STDSYSVIEW)
Launcher.$(O): Launcher.st $(STDSYSVIEW)
+NewLauncher.$(O): NewLauncher.st $(APPMODEL)
ProjectV.$(O): ProjectV.st $(STDSYSVIEW)
-SBrowser.$(O): SBrowser.st $(MODEL)
+SBrowser.$(O): SBrowser.st $(APPMODEL)
BrwsrView.$(O): BrwsrView.st $(STDSYSVIEW)
CBrowser.$(O): CBrowser.st $(STDSYSVIEW)
FBrowser.$(O): FBrowser.st $(STDSYSVIEW)
@@ -105,3 +114,5 @@
SBrowser_1.$(O): SBrowser_1.st $(STDSYSVIEW)
SBrowser_2.$(O): SBrowser_2.st $(STDSYSVIEW)
+
+AboutBox.$(O): AboutBox.st $(INFOBOX)
--- a/MemMonitor.st Sat Mar 25 23:23:29 1995 +0100
+++ b/MemMonitor.st Sat Mar 25 23:24:57 1995 +0100
@@ -10,11 +10,12 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 22-mar-1995 at 7:43:35 am'!
+
StandardSystemView subclass:#MemoryMonitor
- instanceVariableNames:'updateInterval updateBlock myProcess oldData newData
- freeData updateIndex org maxTotal minTotal dX
- newColor freeColor oldColor
- prevTotal prevFree prevFree2 prevOld scale'
+ instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
+ updateIndex org maxTotal minTotal dX newColor freeColor oldColor
+ prevTotal prevFree prevFree2 prevOld scale'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -24,7 +25,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/Attic/MemMonitor.st,v 1.11 1995-03-09 03:31:23 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/MemMonitor.st,v 1.12 1995-03-25 22:24:28 claus Exp $
'!
!MemoryMonitor class methodsFor:'documentation'!
@@ -45,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/MemMonitor.st,v 1.11 1995-03-09 03:31:23 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/MemMonitor.st,v 1.12 1995-03-25 22:24:28 claus Exp $
"
!
@@ -109,11 +110,84 @@
!MemoryMonitor methodsFor:'drawing'!
-redraw
- "redraw all"
+updateDisplay
+ "update picture; trigger next update"
+
+ |total oldSpaceUsed newSpaceUsed freeMem
+ gWidth shift scaleChange margin mustWait|
+
+ shown ifTrue:[
+ oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
+ newSpaceUsed := ObjectMemory newSpaceUsed.
+ freeMem := ObjectMemory freeListSpace.
+ total := oldSpaceUsed + newSpaceUsed.
+
+ scaleChange := false.
+
+ ((total - freeMem) < minTotal) ifTrue:[
+ minTotal := total - freeMem.
+ scaleChange := true
+ ].
+ (total > maxTotal) ifTrue:[
+ maxTotal := total.
+ scaleChange := true
+ ].
+
+ oldData at:updateIndex put:oldSpaceUsed.
+ newData at:updateIndex put:newSpaceUsed.
+ freeData at:updateIndex put:freeMem.
+ updateIndex := updateIndex + 1.
+
+ scaleChange ifTrue:[
+ scale := height asFloat / (maxTotal + 100000).
+ self redraw
+ ].
+
+ gWidth := width - org.
+ margin := 1.
- self clear.
- self redrawX:0 y:0 width:width height:height
+ mustWait := false.
+ ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
+"on slow displays, use:"
+"/ shift := gWidth // 4.
+
+"for smooth display, use:"
+ shift := 1.
+
+ oldData replaceFrom:1 with:oldData startingAt:shift+1.
+ newData replaceFrom:1 with:newData startingAt:shift+1.
+ freeData replaceFrom:1 with:freeData startingAt:shift+1.
+
+ updateIndex := updateIndex - shift.
+ dX := dX + shift.
+
+ self catchExpose.
+ self copyFrom:self
+ x:(org + shift) y:0
+ toX:org y:0
+ width:(gWidth - shift - margin)
+ height:height.
+ self clearRectangleX:(width - margin - shift) y:0
+ width:shift height:height.
+ mustWait := true.
+ ].
+
+ self updateLineX:(updateIndex - 1 + org - 1)
+ total:total
+ old:oldSpaceUsed
+ new:newSpaceUsed
+ free:freeMem.
+
+ self updateNumbers.
+ mustWait ifTrue:[
+ self waitForExpose.
+ ]
+
+ ].
+
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock afterSeconds:updateInterval
+ ].
!
redrawX:x y:y width:w height:h
@@ -300,84 +374,11 @@
self displayOpaqueString:s x:0 y:y.
!
-updateDisplay
- "update picture; trigger next update"
-
- |total oldSpaceUsed newSpaceUsed freeMem
- gWidth shift scaleChange margin mustWait|
-
- shown ifTrue:[
- oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
- newSpaceUsed := ObjectMemory newSpaceUsed.
- freeMem := ObjectMemory freeListSpace.
- total := oldSpaceUsed + newSpaceUsed.
-
- scaleChange := false.
-
- ((total - freeMem) < minTotal) ifTrue:[
- minTotal := total - freeMem.
- scaleChange := true
- ].
- (total > maxTotal) ifTrue:[
- maxTotal := total.
- scaleChange := true
- ].
-
- oldData at:updateIndex put:oldSpaceUsed.
- newData at:updateIndex put:newSpaceUsed.
- freeData at:updateIndex put:freeMem.
- updateIndex := updateIndex + 1.
-
- scaleChange ifTrue:[
- scale := height asFloat / (maxTotal + 100000).
- self redraw
- ].
-
- gWidth := width - org.
- margin := 1.
+redraw
+ "redraw all"
- mustWait := false.
- ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
-"on slow displays, use:"
-"/ shift := gWidth // 4.
-
-"for smooth display, use:"
- shift := 1.
-
- oldData replaceFrom:1 with:oldData startingAt:shift+1.
- newData replaceFrom:1 with:newData startingAt:shift+1.
- freeData replaceFrom:1 with:freeData startingAt:shift+1.
-
- updateIndex := updateIndex - shift.
- dX := dX + shift.
-
- self catchExpose.
- self copyFrom:self
- x:(org + shift) y:0
- toX:org y:0
- width:(gWidth - shift - margin)
- height:height.
- self clearRectangleX:(width - margin - shift) y:0
- width:shift height:height.
- mustWait := true.
- ].
-
- self updateLineX:(updateIndex - 1 + org - 1)
- total:total
- old:oldSpaceUsed
- new:newSpaceUsed
- free:freeMem.
-
- self updateNumbers.
- mustWait ifTrue:[
- self waitForExpose.
- ]
-
- ].
-
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateInterval
- ].
+ self clear.
+ self redrawX:0 y:0 width:width height:height
! !
!MemoryMonitor methodsFor:'destroying'!
@@ -395,23 +396,6 @@
!MemoryMonitor methodsFor:'events'!
-keyPress:key x:x y:y
- key == $f ifTrue:[
- "faster"
- updateInterval := updateInterval / 2
- ].
- key == $s ifTrue:[
- "slower"
- updateInterval := updateInterval * 2
- ].
- key == $r ifTrue:[
- "reset max"
- maxTotal := prevTotal.
- scale := height asFloat / (maxTotal + 100000).
- self redraw.
- ]
-!
-
sizeChanged:how
|nn no nf delta oldSize newSize|
@@ -446,25 +430,69 @@
scale := height asFloat / (maxTotal + 100000).
self clear.
self redraw
+!
+
+keyPress:key x:x y:y
+ key == $f ifTrue:[
+ "faster"
+ updateInterval := updateInterval / 2
+ ].
+ key == $s ifTrue:[
+ "slower"
+ updateInterval := updateInterval * 2
+ ].
+ key == $r ifTrue:[
+ "reset max"
+ maxTotal := prevTotal.
+ scale := height asFloat / (maxTotal + 100000).
+ self redraw.
+ ]
! !
!MemoryMonitor methodsFor:'initialization'!
+memoryMenu
+ |labels selectors|
+
+ labels := #(
+ 'collect Garbage'
+ 'collect Garbage & compress'
+ '-'
+ 'background collect'
+ '-'
+ 'compress sources '
+ ).
+
+ selectors := #(
+ garbageCollect
+ compressingGarbageCollect
+ nil
+ backgroundCollect
+ nil
+ compressSources
+ ).
+
+ ^ PopUpMenu labels:(resources array:labels)
+ selectors:selectors
+ receiver:self
+!
+
realize
super realize.
updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
+ Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
] ifFalse:[
- myProcess := [
- |d|
+ myProcess := [
+ |d|
- [true] whileTrue:[
- (Delay forSeconds:updateInterval) wait.
- self updateDisplay
- ]
- ] forkAt:6.
- myProcess name:'Memory Monitor [' ,
- Processor activeProcess id printString , '] update'
+ [true] whileTrue:[
+ (Delay forSeconds:updateInterval) wait.
+ self updateDisplay
+ ]
+ ] forkAt:6.
+ myProcess name:'monitor [' ,
+ Processor activeProcess id printString ,
+ '] update'
].
newColor := newColor on:device.
@@ -513,32 +541,6 @@
"
MemoryMonitor open
"
-!
-
-memoryMenu
- |labels selectors|
-
- labels := #(
- 'collect Garbage'
- 'collect Garbage & compress'
- '-'
- 'background collect'
- '-'
- 'compress sources '
- ).
-
- selectors := #(
- garbageCollect
- compressingGarbageCollect
- nil
- backgroundCollect
- nil
- compressSources
- ).
-
- ^ PopUpMenu labels:(resources array:labels)
- selectors:selectors
- receiver:self
! !
!MemoryMonitor methodsFor:'menu functions'!
@@ -551,11 +553,12 @@
ObjectMemory verboseGarbageCollect
!
-backgroundCollect
- [ObjectMemory incrementalGC] forkAt:5
-!
-
compressSources
Smalltalk compressSources.
ObjectMemory markAndSweep
+!
+
+backgroundCollect
+ [ObjectMemory incrementalGC] forkAt:5
! !
+
--- a/MemoryMonitor.st Sat Mar 25 23:23:29 1995 +0100
+++ b/MemoryMonitor.st Sat Mar 25 23:24:57 1995 +0100
@@ -10,11 +10,12 @@
hereby transferred.
"
+'From Smalltalk/X, Version:2.10.5 on 22-mar-1995 at 7:43:35 am'!
+
StandardSystemView subclass:#MemoryMonitor
- instanceVariableNames:'updateInterval updateBlock myProcess oldData newData
- freeData updateIndex org maxTotal minTotal dX
- newColor freeColor oldColor
- prevTotal prevFree prevFree2 prevOld scale'
+ instanceVariableNames:'updateInterval updateBlock myProcess oldData newData freeData
+ updateIndex org maxTotal minTotal dX newColor freeColor oldColor
+ prevTotal prevFree prevFree2 prevOld scale'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -24,7 +25,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.11 1995-03-09 03:31:23 claus Exp $
+$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.12 1995-03-25 22:24:28 claus Exp $
'!
!MemoryMonitor class methodsFor:'documentation'!
@@ -45,7 +46,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.11 1995-03-09 03:31:23 claus Exp $
+$Header: /cvs/stx/stx/libtool/MemoryMonitor.st,v 1.12 1995-03-25 22:24:28 claus Exp $
"
!
@@ -109,11 +110,84 @@
!MemoryMonitor methodsFor:'drawing'!
-redraw
- "redraw all"
+updateDisplay
+ "update picture; trigger next update"
+
+ |total oldSpaceUsed newSpaceUsed freeMem
+ gWidth shift scaleChange margin mustWait|
+
+ shown ifTrue:[
+ oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
+ newSpaceUsed := ObjectMemory newSpaceUsed.
+ freeMem := ObjectMemory freeListSpace.
+ total := oldSpaceUsed + newSpaceUsed.
+
+ scaleChange := false.
+
+ ((total - freeMem) < minTotal) ifTrue:[
+ minTotal := total - freeMem.
+ scaleChange := true
+ ].
+ (total > maxTotal) ifTrue:[
+ maxTotal := total.
+ scaleChange := true
+ ].
+
+ oldData at:updateIndex put:oldSpaceUsed.
+ newData at:updateIndex put:newSpaceUsed.
+ freeData at:updateIndex put:freeMem.
+ updateIndex := updateIndex + 1.
+
+ scaleChange ifTrue:[
+ scale := height asFloat / (maxTotal + 100000).
+ self redraw
+ ].
+
+ gWidth := width - org.
+ margin := 1.
- self clear.
- self redrawX:0 y:0 width:width height:height
+ mustWait := false.
+ ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
+"on slow displays, use:"
+"/ shift := gWidth // 4.
+
+"for smooth display, use:"
+ shift := 1.
+
+ oldData replaceFrom:1 with:oldData startingAt:shift+1.
+ newData replaceFrom:1 with:newData startingAt:shift+1.
+ freeData replaceFrom:1 with:freeData startingAt:shift+1.
+
+ updateIndex := updateIndex - shift.
+ dX := dX + shift.
+
+ self catchExpose.
+ self copyFrom:self
+ x:(org + shift) y:0
+ toX:org y:0
+ width:(gWidth - shift - margin)
+ height:height.
+ self clearRectangleX:(width - margin - shift) y:0
+ width:shift height:height.
+ mustWait := true.
+ ].
+
+ self updateLineX:(updateIndex - 1 + org - 1)
+ total:total
+ old:oldSpaceUsed
+ new:newSpaceUsed
+ free:freeMem.
+
+ self updateNumbers.
+ mustWait ifTrue:[
+ self waitForExpose.
+ ]
+
+ ].
+
+ updateBlock notNil ifTrue:[
+ Processor addTimedBlock:updateBlock afterSeconds:updateInterval
+ ].
!
redrawX:x y:y width:w height:h
@@ -300,84 +374,11 @@
self displayOpaqueString:s x:0 y:y.
!
-updateDisplay
- "update picture; trigger next update"
-
- |total oldSpaceUsed newSpaceUsed freeMem
- gWidth shift scaleChange margin mustWait|
-
- shown ifTrue:[
- oldSpaceUsed := ObjectMemory oldSpaceUsed + ObjectMemory fixSpaceUsed.
- newSpaceUsed := ObjectMemory newSpaceUsed.
- freeMem := ObjectMemory freeListSpace.
- total := oldSpaceUsed + newSpaceUsed.
-
- scaleChange := false.
-
- ((total - freeMem) < minTotal) ifTrue:[
- minTotal := total - freeMem.
- scaleChange := true
- ].
- (total > maxTotal) ifTrue:[
- maxTotal := total.
- scaleChange := true
- ].
-
- oldData at:updateIndex put:oldSpaceUsed.
- newData at:updateIndex put:newSpaceUsed.
- freeData at:updateIndex put:freeMem.
- updateIndex := updateIndex + 1.
-
- scaleChange ifTrue:[
- scale := height asFloat / (maxTotal + 100000).
- self redraw
- ].
-
- gWidth := width - org.
- margin := 1.
+redraw
+ "redraw all"
- mustWait := false.
- ((updateIndex-1) >= (gWidth - margin)) ifTrue:[
-"on slow displays, use:"
-"/ shift := gWidth // 4.
-
-"for smooth display, use:"
- shift := 1.
-
- oldData replaceFrom:1 with:oldData startingAt:shift+1.
- newData replaceFrom:1 with:newData startingAt:shift+1.
- freeData replaceFrom:1 with:freeData startingAt:shift+1.
-
- updateIndex := updateIndex - shift.
- dX := dX + shift.
-
- self catchExpose.
- self copyFrom:self
- x:(org + shift) y:0
- toX:org y:0
- width:(gWidth - shift - margin)
- height:height.
- self clearRectangleX:(width - margin - shift) y:0
- width:shift height:height.
- mustWait := true.
- ].
-
- self updateLineX:(updateIndex - 1 + org - 1)
- total:total
- old:oldSpaceUsed
- new:newSpaceUsed
- free:freeMem.
-
- self updateNumbers.
- mustWait ifTrue:[
- self waitForExpose.
- ]
-
- ].
-
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateInterval
- ].
+ self clear.
+ self redrawX:0 y:0 width:width height:height
! !
!MemoryMonitor methodsFor:'destroying'!
@@ -395,23 +396,6 @@
!MemoryMonitor methodsFor:'events'!
-keyPress:key x:x y:y
- key == $f ifTrue:[
- "faster"
- updateInterval := updateInterval / 2
- ].
- key == $s ifTrue:[
- "slower"
- updateInterval := updateInterval * 2
- ].
- key == $r ifTrue:[
- "reset max"
- maxTotal := prevTotal.
- scale := height asFloat / (maxTotal + 100000).
- self redraw.
- ]
-!
-
sizeChanged:how
|nn no nf delta oldSize newSize|
@@ -446,25 +430,69 @@
scale := height asFloat / (maxTotal + 100000).
self clear.
self redraw
+!
+
+keyPress:key x:x y:y
+ key == $f ifTrue:[
+ "faster"
+ updateInterval := updateInterval / 2
+ ].
+ key == $s ifTrue:[
+ "slower"
+ updateInterval := updateInterval * 2
+ ].
+ key == $r ifTrue:[
+ "reset max"
+ maxTotal := prevTotal.
+ scale := height asFloat / (maxTotal + 100000).
+ self redraw.
+ ]
! !
!MemoryMonitor methodsFor:'initialization'!
+memoryMenu
+ |labels selectors|
+
+ labels := #(
+ 'collect Garbage'
+ 'collect Garbage & compress'
+ '-'
+ 'background collect'
+ '-'
+ 'compress sources '
+ ).
+
+ selectors := #(
+ garbageCollect
+ compressingGarbageCollect
+ nil
+ backgroundCollect
+ nil
+ compressSources
+ ).
+
+ ^ PopUpMenu labels:(resources array:labels)
+ selectors:selectors
+ receiver:self
+!
+
realize
super realize.
updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
+ Processor addTimedBlock:updateBlock afterSeconds:updateInterval.
] ifFalse:[
- myProcess := [
- |d|
+ myProcess := [
+ |d|
- [true] whileTrue:[
- (Delay forSeconds:updateInterval) wait.
- self updateDisplay
- ]
- ] forkAt:6.
- myProcess name:'Memory Monitor [' ,
- Processor activeProcess id printString , '] update'
+ [true] whileTrue:[
+ (Delay forSeconds:updateInterval) wait.
+ self updateDisplay
+ ]
+ ] forkAt:6.
+ myProcess name:'monitor [' ,
+ Processor activeProcess id printString ,
+ '] update'
].
newColor := newColor on:device.
@@ -513,32 +541,6 @@
"
MemoryMonitor open
"
-!
-
-memoryMenu
- |labels selectors|
-
- labels := #(
- 'collect Garbage'
- 'collect Garbage & compress'
- '-'
- 'background collect'
- '-'
- 'compress sources '
- ).
-
- selectors := #(
- garbageCollect
- compressingGarbageCollect
- nil
- backgroundCollect
- nil
- compressSources
- ).
-
- ^ PopUpMenu labels:(resources array:labels)
- selectors:selectors
- receiver:self
! !
!MemoryMonitor methodsFor:'menu functions'!
@@ -551,11 +553,12 @@
ObjectMemory verboseGarbageCollect
!
-backgroundCollect
- [ObjectMemory incrementalGC] forkAt:5
-!
-
compressSources
Smalltalk compressSources.
ObjectMemory markAndSweep
+!
+
+backgroundCollect
+ [ObjectMemory incrementalGC] forkAt:5
! !
+
--- a/OldLauncher.st Sat Mar 25 23:23:29 1995 +0100
+++ b/OldLauncher.st Sat Mar 25 23:24:57 1995 +0100
@@ -21,7 +21,7 @@
COPYRIGHT (c) 1991 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.25 1995-03-20 06:04:25 claus Exp $
+$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.26 1995-03-25 22:24:20 claus Exp $
'!
!Launcher class methodsFor:'documentation'!
@@ -42,7 +42,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.25 1995-03-20 06:04:25 claus Exp $
+$Header: /cvs/stx/stx/libtool/OldLauncher.st,v 1.26 1995-03-25 22:24:20 claus Exp $
"
!
@@ -947,38 +947,7 @@
!
showAbout
- |box dark green lbl|
-
- device hasColors ifTrue:[
- green := (Color red:0 green:80 blue:20) darkened.
- ] ifFalse:[
- green := White.
- ].
- device hasGreyscales ifTrue:[
- dark := Color grey:10.
- ] ifFalse:[
- dark := Black.
- ].
-
- box := InfoBox new.
- box viewBackground:dark; allSubViewsDo:[:s | s viewBackground:dark].
- box form:(Form fromFile:'SmalltalkX.xbm' resolution:100).
- (lbl := box formLabel) viewBackground:dark.
- lbl foregroundColor:green backgroundColor:dark.
- (lbl := box textLabel) viewBackground:dark.
- lbl foregroundColor:White backgroundColor:dark.
- box title:
-'Smalltalk/X
-
-Version ......... ' , Smalltalk versionString , ' (' , Smalltalk versionDate printString , ')
-Configuration ... ' , Smalltalk configuration , '
-Running on ...... ' , OperatingSystem getHostName , '
-
-' , Smalltalk copyrightString.
-
- box okText:'close'.
- box autoHideAfter:10 with:[].
- box showAt:device center - (box extent // 2).
+ AboutBox new show
!
showOverview
@@ -1001,3 +970,11 @@
'.
self showDocumentFile:'doc/online/english/' , baseName
! !
+
+!Launcher methodsFor:'misc'!
+
+processName
+ "the name of my process - for the processMonitor only"
+
+ ^ 'Launcher'.
+! !
--- a/ProcMonitor.st Sat Mar 25 23:23:29 1995 +0100
+++ b/ProcMonitor.st Sat Mar 25 23:24:57 1995 +0100
@@ -10,10 +10,12 @@
hereby transferred.
"
-StandardSystemView subclass:#ProcessMonitor
- instanceVariableNames:'listView processes listUpdateDelay updateDelay
- updateBlock listUpdateBlock updateProcess hideDead
- runColor suspendedColor waitColor cpuUsages'
+'From Smalltalk/X, Version:2.10.5 on 24-mar-1995 at 11:25:51 am'!
+
+View subclass:#ProcessMonitor
+ instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -37,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.7 1995-02-08 03:21:02 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/ProcMonitor.st,v 1.8 1995-03-25 22:24:39 claus Exp $
"
!
@@ -47,23 +49,26 @@
a popup menu for various useful operations on them.
Especially 'debug' is useful, to see what a process is currently
doing.
+
The information shown is:
- id - the numeric id of the process
- name - the name (if any) of the process
- (the name has no semantic meaning; its for the processMonitor)
- state - what is it doing;
- wait - waiting on a semaphore
- eventWait - waiting on a view-event semaphore
- ioWait - waiting on an io-semaphore
- timeWait - waiting for a time-semaphore
- run - run, but currently not scheduled
- active - really running
- suspended - suspended; not waiting on a semaphore
- light - not yet started (i.e. has no stack yet)
+ id - the numeric id of the process
+ name - the name (if any) of the process
+ (the name has no semantic meaning; it exists for the processMonitor only)
+ state - what is it doing;
+ wait - waiting on a semaphore
+ eventWait - waiting on a view-event semaphore
+ ioWait - waiting on an io-semaphore
+ timeWait - waiting for a time-semaphore
+ run - run, but currently not scheduled
+ active - really running (this info is useless, since at
+ update time, its always the update process which is
+ running)
+ suspended - suspended; not waiting on a semaphore
+ light - not yet started (i.e. has no stack yet)
- prio - the processes priority (1..30)
- usedStack - the current stack use
- totalStack - the stack currently allocated
+ prio - the processes priority (1..30)
+ usedStack - the current stack use
+ totalStack - the stack currently allocated (i.e. the maximum ever needed)
"
! !
@@ -78,7 +83,170 @@
i := Image fromFile:'bitmaps/ProcMon.xbm'.
i notNil ifTrue:[^ i].
- ^ super defaultIcon
+ ^ StandardSystemView defaultIcon
+! !
+
+!ProcessMonitor class methodsFor:'startup'!
+
+open
+ |top monitor|
+
+ top := StandardSystemView new.
+ monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.
+ top extent:monitor preferedExtent.
+ top label:self defaultLabel.
+ top icon:self defaultIcon.
+ top open
+
+ "
+ ProcessMonitor open
+ "
+! !
+
+!ProcessMonitor methodsFor:'drawing'!
+
+titleLine
+"/ ^ 'id name cpu state prio usedStack totalStack'.
+ ^ 'id name state prio usedStack totalStack'.
+!
+
+updateList
+ "update list of processes"
+
+ |newList|
+
+ shown ifTrue:[
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ newList := Process allInstances.
+ ] ifFalse:[
+ newList := ProcessorScheduler knownProcesses asOrderedCollection.
+ ].
+
+ "sort by id - take care of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
+
+ (p1 isNil or:[(id1 := p1 id) isNil])
+ ifTrue:[true]
+ ifFalse:[
+ (p2 isNil or:[(id2 := p2 id) isNil])
+ ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
+ ].
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:listUpdateBlock.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
+ ].
+!
+
+updateStatus
+ "update status display of processes"
+
+ |oldList list line dIndex con interrupted|
+
+ shown ifTrue:[
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
+
+ interrupted := Processor interruptedProcess.
+
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |aProcess nm st c n|
+
+ aProcess := processes at:index.
+ aProcess notNil ifTrue:[
+ (aProcess id notNil or:[hideDead not]) ifTrue:[
+ line := aProcess id printStringPaddedTo:5.
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printString
+ ] ifTrue:[
+ nm := ' '
+ ].
+ nm size >= 29 ifTrue:[
+ nm := (nm contractTo:28) , ' '
+ ] ifFalse:[
+ nm := (nm printStringPaddedTo:29).
+ ].
+ line := line , nm.
+"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
+"/ n ~~ 0 ifTrue:[
+"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
+"/ ] ifFalse:[
+"/ line := line , ' '
+"/ ].
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ ] ifFalse:[
+ c := ' '.
+ ].
+ line := line , c , (st printStringPaddedTo:9).
+ line := line , (aProcess priority printStringLeftPaddedTo:3).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , aProcess numberOfStackSegments printString , ')'.
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ line := line , ' .. '.
+ [con sender notNil] whileTrue:[
+ con := con sender
+ ].
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ ]
+ ].
+ list add:line.
+ processes at:dIndex put:aProcess.
+ dIndex := dIndex + 1
+ ]
+ ].
+ ].
+ dIndex to:processes size do:[:index |
+ processes at:index put:nil
+ ]
+ ].
+ "avoid flicker"
+ (oldList notNil and:[oldList size == list size]) ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ "the first two entries cannot be selected"
+ listView attributeAt:1 put:#disabled.
+ listView attributeAt:2 put:#disabled.
+ ]
+ ].
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ ]
+!
+
+updateView
+ self updateList.
+ self updateStatus
+
! !
!ProcessMonitor methodsFor:'initialization'!
@@ -90,50 +258,14 @@
hideDead := true.
- 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.
+
+"/ self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.
+
listView := v scrolledView.
listView font:font.
- menu := (PopUpMenu
- labels:#(
-"/ hideDead functionality no longer needed;
-"/ since ProcSched knownProcesses only returns living ones
-"/
-"/ '\c hide dead'
-"/ '-'
- 'inspect'
- 'debug'
- '-'
- 'resume'
- 'suspend'
- 'abort'
- 'terminate'
- '-'
- 'raise prio'
- 'lower prio'
- )
- selectors:#(
-"/ hideDead:
-"/ nil
- inspectProcess
- debugProcess
- nil
- resumeProcess
- suspendProcess
- abortProcess
- terminateProcess
- nil
- raisePrio
- lowerPrio
- )
- receiver:self
- for:listView).
-"/ menu checkToggleAt:#hideDead: put:hideDead.
- listView middleButtonMenu:menu.
+ listView model:self; menu:#processMenu.
listView multipleSelectOk:true.
listView keyboardHandler:self.
@@ -144,16 +276,16 @@
"/ true
ProcessorScheduler isPureEventDriven
ifTrue:[
- updateBlock := [self updateStatus].
- listUpdateBlock := [self updateList].
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
].
device hasColors ifTrue:[
- runColor := Color green.
- suspendedColor := Color yellow.
- waitColor := Color red.
+ runColor := Color green.
+ suspendedColor := Color yellow.
+ waitColor := Color red.
] ifFalse:[
- runColor := suspendedColor := waitColor := Color black
+ runColor := suspendedColor := waitColor := Color black
]
"
@@ -161,65 +293,59 @@
"
!
+mapped
+ super mapped.
+ self updateStatus.
+ self updateList.
+!
+
realize
super realize.
updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
] ifFalse:[
- updateProcess := [
- |id cnt|
+ updateProcess := [
+ Process terminateSignal handle:[:ex |
+ updateProcess := nil
+ ] do:[
+ |id cnt|
- "
- every 20ms, we look which process runs;
- every half second, the status is updated.
- every 5 seconds, the list of processes is
- built up again
- "
- [true] whileTrue:[
- 1 to:9 do:[:i |
-"/ cpuUsages := IdentityDictionary new.
-"/ 1 to:25 do:[:i |
-"/ (Delay forSeconds:0.02) wait.
-"/ id := Processor interruptedProcess id.
-"/ cnt := cpuUsages at:id ifAbsent:[0].
-"/ cpuUsages at:id put:cnt + 1.
-"/ ].
- (Delay forSeconds:0.5) wait.
- self updateStatus.
- ].
- (Delay forSeconds:0.5) wait.
- self updateList.
- ]
- ] forkAt:(Processor userSchedulingPriority + 1).
- updateProcess name:'process update'.
- "
- raise my own priority
- "
- Processor activeProcess priority:(Processor userSchedulingPriority + 2)
+ "
+ every 20ms, we look which process runs;
+ every half second, the status is updated.
+ every 5 seconds, the list of processes is
+ built up again
+ "
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
+"/ cpuUsages := IdentityDictionary new.
+"/ 1 to:25 do:[:i |
+"/ (Delay forSeconds:0.02) wait.
+"/ id := Processor interruptedProcess id.
+"/ cnt := cpuUsages at:id ifAbsent:[0].
+"/ cpuUsages at:id put:cnt + 1.
+"/ ].
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList.
+ ]
+ ]
+ ] forkAt:(Processor userSchedulingPriority + 1).
+ updateProcess name:'monitor [' ,
+ Processor activeProcess id printString ,
+ '] update'.
+ "
+ raise my own priority
+ "
+ Processor activeProcess priority:(Processor userSchedulingPriority + 2)
].
waitColor := waitColor on:device.
runColor := runColor on:device.
suspendedColor := suspendedColor on:device.
-!
-
-mapped
- super mapped.
- self updateStatus.
- self updateList.
-! !
-
-!ProcessMonitor methodsFor:'destroying'!
-
-destroy
- updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor removeTimedBlock:listUpdateBlock.
- ] ifFalse:[
- updateProcess terminate
- ].
- super destroy
! !
!ProcessMonitor methodsFor:'private'!
@@ -230,77 +356,124 @@
sel := listView selection.
sel isNil ifTrue:[^ self].
(sel isKindOf:Collection) ifTrue:[
- sel do:[:n |
- nr := n - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
- ]
+ sel do:[:n |
+ nr := n - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
-"/ self updateStatus.
-"/ self updateList.
!
selectedProcessesSend:aSelector
self selectedProcessesDo:[:p |
- p perform:aSelector
- ]
+ p perform:aSelector
+ ].
+ self updateView.
! !
!ProcessMonitor methodsFor:'menu actions'!
-hideDead:aBoolean
- hideDead := aBoolean
+terminateProcess
+ self selectedProcessesSend:#terminate
!
debugProcess
self selectedProcessesDo:[:p |
Debugger openOn:p
]
-!
+!
-inspectProcess
- self selectedProcessesSend:#inspect
-!
+hideDead:aBoolean
+ hideDead := aBoolean
+!
abortProcess
self selectedProcessesDo:[:p |
p interruptWith:[AbortSignal raise]
]
-!
+!
-terminateProcess
- self selectedProcessesSend:#terminate
-!
+inspectProcess
+ self selectedProcessesSend:#inspect
+!
resumeProcess
self selectedProcessesSend:#resume
-!
+!
+
+processMenu
+ |labels selectors m|
+
+ labels := resources array:#(
+"/ hideDead functionality no longer needed;
+"/ since ProcSched knownProcesses only returns living ones
+"/
+"/ '\c hide dead'
+"/ '-'
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'abort'
+ 'terminate'
+ '-'
+ 'raise prio'
+ 'lower prio'
+ ).
+ selectors := #(
+"/ hideDead:
+"/ nil
+ inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ abortProcess
+ terminateProcess
+ nil
+ raisePrio
+ lowerPrio
+ ).
+
+ updateProcess isNil ifTrue:[
+ labels := (resources array:#('update' '-')) , labels.
+ selectors := #(updateView nil) , selectors
+ ].
+
+ m := PopUpMenu labels:labels
+ selectors:selectors.
+
+"/ m checkToggleAt:#hideDead: put:hideDead.
+
+ ^ m
+!
suspendProcess
self selectedProcessesSend:#suspend
-!
+!
raisePrio
self selectedProcessesDo:[:p |
p priority:(p priority + 1)
]
-!
+!
lowerPrio
self selectedProcessesDo:[:p |
@@ -308,6 +481,24 @@
]
! !
+!ProcessMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
+ ] ifFalse:[
+ updateProcess notNil ifTrue:[updateProcess terminate]
+ ].
+ super destroy
+! !
+
+!ProcessMonitor methodsFor:'queries'!
+
+preferedExtent
+ ^ (font widthOf:self titleLine) + 40 @ 100
+! !
+
!ProcessMonitor methodsFor:'events'!
canHandle:key
@@ -321,136 +512,3 @@
^ super keyPress:key x:x y:y
! !
-!ProcessMonitor methodsFor:'drawing'!
-
-updateList
- "update list of processes"
-
- |newList|
-
- shown ifTrue:[
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- newList := Process allInstances.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
-
- "sort by id - take care of nil ids of dead processes"
- newList sort:[:p1 :p2 |
- |id1 id2|
-
- (p1 isNil or:[(id1 := p1 id) isNil])
- ifTrue:[true]
- ifFalse:[
- (p2 isNil or:[(id2 := p2 id) isNil])
- ifTrue:[false]
- ifFalse:[id1 < id2]
- ]
- ].
- newList ~= processes ifTrue:[
- processes := WeakArray withAll:newList.
- self updateStatus
- ].
- ].
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
- ].
-!
-
-updateStatus
- "update status display of processes"
-
- |oldList list line dIndex con interrupted|
-
- shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- list := OrderedCollection new.
-"/ list add:'id name cpu state prio usedStack totalStack'.
- list add:'id name state prio usedStack totalStack'.
- list add:'--------------------------------------------------------------------------'.
-
- interrupted := Processor interruptedProcess.
-
- dIndex := 1.
- 1 to:processes size do:[:index |
- |aProcess nm st c n|
-
- aProcess := processes at:index.
- aProcess notNil ifTrue:[
- (aProcess id notNil or:[hideDead not]) ifTrue:[
- line := aProcess id printStringPaddedTo:5.
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printString
- ] ifTrue:[
- nm := ' '
- ].
- nm size >= 29 ifTrue:[
- nm := (nm contractTo:28) , ' '
- ] ifFalse:[
- nm := (nm printStringPaddedTo:29).
- ].
- line := line , nm.
-"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
-"/ n ~~ 0 ifTrue:[
-"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
-"/ ] ifFalse:[
-"/ line := line , ' '
-"/ ].
- st := aProcess state.
- (st == #run
- and:[aProcess == interrupted]) ifTrue:[
- c := ' *'.
- ] ifFalse:[
- c := ' '.
- ].
- line := line , c , (st printStringPaddedTo:9).
- line := line , (aProcess priority printStringLeftPaddedTo:3).
- line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , aProcess numberOfStackSegments printString , ')'.
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ].
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- [con sender notNil] whileTrue:[
- con := con sender
- ].
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- ]
- ].
- list add:line.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
- "avoid flicker"
- (oldList notNil and:[oldList size == list size]) ifTrue:[
- list keysAndValuesDo:[:idx :entry |
- (oldList at:idx) ~= entry ifTrue:[
- listView at:idx put:entry
- ]
- ]
- ] ifFalse:[
- listView setList:list.
- "the first two entries cannot be selected"
- listView attributeAt:1 put:#disabled.
- listView attributeAt:2 put:#disabled.
- ]
- ].
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
- ]
-! !
--- a/ProcessMonitor.st Sat Mar 25 23:23:29 1995 +0100
+++ b/ProcessMonitor.st Sat Mar 25 23:24:57 1995 +0100
@@ -10,10 +10,12 @@
hereby transferred.
"
-StandardSystemView subclass:#ProcessMonitor
- instanceVariableNames:'listView processes listUpdateDelay updateDelay
- updateBlock listUpdateBlock updateProcess hideDead
- runColor suspendedColor waitColor cpuUsages'
+'From Smalltalk/X, Version:2.10.5 on 24-mar-1995 at 11:25:51 am'!
+
+View subclass:#ProcessMonitor
+ instanceVariableNames:'listView processes listUpdateDelay updateDelay updateBlock
+ listUpdateBlock updateProcess hideDead runColor suspendedColor
+ waitColor cpuUsages'
classVariableNames:''
poolDictionaries:''
category:'Interface-Tools'
@@ -37,7 +39,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.7 1995-02-08 03:21:02 claus Exp $
+$Header: /cvs/stx/stx/libtool/ProcessMonitor.st,v 1.8 1995-03-25 22:24:39 claus Exp $
"
!
@@ -47,23 +49,26 @@
a popup menu for various useful operations on them.
Especially 'debug' is useful, to see what a process is currently
doing.
+
The information shown is:
- id - the numeric id of the process
- name - the name (if any) of the process
- (the name has no semantic meaning; its for the processMonitor)
- state - what is it doing;
- wait - waiting on a semaphore
- eventWait - waiting on a view-event semaphore
- ioWait - waiting on an io-semaphore
- timeWait - waiting for a time-semaphore
- run - run, but currently not scheduled
- active - really running
- suspended - suspended; not waiting on a semaphore
- light - not yet started (i.e. has no stack yet)
+ id - the numeric id of the process
+ name - the name (if any) of the process
+ (the name has no semantic meaning; it exists for the processMonitor only)
+ state - what is it doing;
+ wait - waiting on a semaphore
+ eventWait - waiting on a view-event semaphore
+ ioWait - waiting on an io-semaphore
+ timeWait - waiting for a time-semaphore
+ run - run, but currently not scheduled
+ active - really running (this info is useless, since at
+ update time, its always the update process which is
+ running)
+ suspended - suspended; not waiting on a semaphore
+ light - not yet started (i.e. has no stack yet)
- prio - the processes priority (1..30)
- usedStack - the current stack use
- totalStack - the stack currently allocated
+ prio - the processes priority (1..30)
+ usedStack - the current stack use
+ totalStack - the stack currently allocated (i.e. the maximum ever needed)
"
! !
@@ -78,7 +83,170 @@
i := Image fromFile:'bitmaps/ProcMon.xbm'.
i notNil ifTrue:[^ i].
- ^ super defaultIcon
+ ^ StandardSystemView defaultIcon
+! !
+
+!ProcessMonitor class methodsFor:'startup'!
+
+open
+ |top monitor|
+
+ top := StandardSystemView new.
+ monitor := self origin:0.0@0.0 corner:1.0@1.0 in:top.
+ top extent:monitor preferedExtent.
+ top label:self defaultLabel.
+ top icon:self defaultIcon.
+ top open
+
+ "
+ ProcessMonitor open
+ "
+! !
+
+!ProcessMonitor methodsFor:'drawing'!
+
+titleLine
+"/ ^ 'id name cpu state prio usedStack totalStack'.
+ ^ 'id name state prio usedStack totalStack'.
+!
+
+updateList
+ "update list of processes"
+
+ |newList|
+
+ shown ifTrue:[
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ newList := Process allInstances.
+ ] ifFalse:[
+ newList := ProcessorScheduler knownProcesses asOrderedCollection.
+ ].
+
+ "sort by id - take care of nil ids of dead processes"
+ newList sort:[:p1 :p2 |
+ |id1 id2|
+
+ (p1 isNil or:[(id1 := p1 id) isNil])
+ ifTrue:[true]
+ ifFalse:[
+ (p2 isNil or:[(id2 := p2 id) isNil])
+ ifTrue:[false]
+ ifFalse:[id1 < id2]
+ ]
+ ].
+ newList ~= processes ifTrue:[
+ processes := WeakArray withAll:newList.
+ self updateStatus
+ ].
+ ].
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:listUpdateBlock.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
+ ].
+!
+
+updateStatus
+ "update status display of processes"
+
+ |oldList list line dIndex con interrupted|
+
+ shown ifTrue:[
+ oldList := listView list.
+ processes notNil ifTrue:[
+ list := OrderedCollection new.
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
+
+ interrupted := Processor interruptedProcess.
+
+ dIndex := 1.
+ 1 to:processes size do:[:index |
+ |aProcess nm st c n|
+
+ aProcess := processes at:index.
+ aProcess notNil ifTrue:[
+ (aProcess id notNil or:[hideDead not]) ifTrue:[
+ line := aProcess id printStringPaddedTo:5.
+ (nm := aProcess name) isNil ifFalse:[
+ nm := nm printString
+ ] ifTrue:[
+ nm := ' '
+ ].
+ nm size >= 29 ifTrue:[
+ nm := (nm contractTo:28) , ' '
+ ] ifFalse:[
+ nm := (nm printStringPaddedTo:29).
+ ].
+ line := line , nm.
+"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
+"/ n ~~ 0 ifTrue:[
+"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
+"/ ] ifFalse:[
+"/ line := line , ' '
+"/ ].
+ st := aProcess state.
+ (st == #run
+ and:[aProcess == interrupted]) ifTrue:[
+ c := ' *'.
+ ] ifFalse:[
+ c := ' '.
+ ].
+ line := line , c , (st printStringPaddedTo:9).
+ line := line , (aProcess priority printStringLeftPaddedTo:3).
+ line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
+ line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
+ line := line , '(' , aProcess numberOfStackSegments printString , ')'.
+ (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
+ con := aProcess suspendedContext.
+ con isNil ifTrue:[
+ aProcess == Processor activeProcess ifTrue:[
+ con := thisContext
+ ]
+ ].
+ con notNil ifTrue:[
+ line := line , ' '.
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ line := line , ' .. '.
+ [con sender notNil] whileTrue:[
+ con := con sender
+ ].
+ line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
+ ]
+ ].
+ list add:line.
+ processes at:dIndex put:aProcess.
+ dIndex := dIndex + 1
+ ]
+ ].
+ ].
+ dIndex to:processes size do:[:index |
+ processes at:index put:nil
+ ]
+ ].
+ "avoid flicker"
+ (oldList notNil and:[oldList size == list size]) ifTrue:[
+ list keysAndValuesDo:[:idx :entry |
+ (oldList at:idx) ~= entry ifTrue:[
+ listView at:idx put:entry
+ ]
+ ]
+ ] ifFalse:[
+ listView setList:list.
+ "the first two entries cannot be selected"
+ listView attributeAt:1 put:#disabled.
+ listView attributeAt:2 put:#disabled.
+ ]
+ ].
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ ]
+!
+
+updateView
+ self updateList.
+ self updateStatus
+
! !
!ProcessMonitor methodsFor:'initialization'!
@@ -90,50 +258,14 @@
hideDead := true.
- 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.
+
+"/ self extent:(font widthOf:self titleLine) + v scrollBar width @ 100.
+
listView := v scrolledView.
listView font:font.
- menu := (PopUpMenu
- labels:#(
-"/ hideDead functionality no longer needed;
-"/ since ProcSched knownProcesses only returns living ones
-"/
-"/ '\c hide dead'
-"/ '-'
- 'inspect'
- 'debug'
- '-'
- 'resume'
- 'suspend'
- 'abort'
- 'terminate'
- '-'
- 'raise prio'
- 'lower prio'
- )
- selectors:#(
-"/ hideDead:
-"/ nil
- inspectProcess
- debugProcess
- nil
- resumeProcess
- suspendProcess
- abortProcess
- terminateProcess
- nil
- raisePrio
- lowerPrio
- )
- receiver:self
- for:listView).
-"/ menu checkToggleAt:#hideDead: put:hideDead.
- listView middleButtonMenu:menu.
+ listView model:self; menu:#processMenu.
listView multipleSelectOk:true.
listView keyboardHandler:self.
@@ -144,16 +276,16 @@
"/ true
ProcessorScheduler isPureEventDriven
ifTrue:[
- updateBlock := [self updateStatus].
- listUpdateBlock := [self updateList].
+ updateBlock := [self updateStatus].
+ listUpdateBlock := [self updateList].
].
device hasColors ifTrue:[
- runColor := Color green.
- suspendedColor := Color yellow.
- waitColor := Color red.
+ runColor := Color green.
+ suspendedColor := Color yellow.
+ waitColor := Color red.
] ifFalse:[
- runColor := suspendedColor := waitColor := Color black
+ runColor := suspendedColor := waitColor := Color black
]
"
@@ -161,65 +293,59 @@
"
!
+mapped
+ super mapped.
+ self updateStatus.
+ self updateList.
+!
+
realize
super realize.
updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay.
+ Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay.
] ifFalse:[
- updateProcess := [
- |id cnt|
+ updateProcess := [
+ Process terminateSignal handle:[:ex |
+ updateProcess := nil
+ ] do:[
+ |id cnt|
- "
- every 20ms, we look which process runs;
- every half second, the status is updated.
- every 5 seconds, the list of processes is
- built up again
- "
- [true] whileTrue:[
- 1 to:9 do:[:i |
-"/ cpuUsages := IdentityDictionary new.
-"/ 1 to:25 do:[:i |
-"/ (Delay forSeconds:0.02) wait.
-"/ id := Processor interruptedProcess id.
-"/ cnt := cpuUsages at:id ifAbsent:[0].
-"/ cpuUsages at:id put:cnt + 1.
-"/ ].
- (Delay forSeconds:0.5) wait.
- self updateStatus.
- ].
- (Delay forSeconds:0.5) wait.
- self updateList.
- ]
- ] forkAt:(Processor userSchedulingPriority + 1).
- updateProcess name:'process update'.
- "
- raise my own priority
- "
- Processor activeProcess priority:(Processor userSchedulingPriority + 2)
+ "
+ every 20ms, we look which process runs;
+ every half second, the status is updated.
+ every 5 seconds, the list of processes is
+ built up again
+ "
+ [true] whileTrue:[
+ 1 to:9 do:[:i |
+"/ cpuUsages := IdentityDictionary new.
+"/ 1 to:25 do:[:i |
+"/ (Delay forSeconds:0.02) wait.
+"/ id := Processor interruptedProcess id.
+"/ cnt := cpuUsages at:id ifAbsent:[0].
+"/ cpuUsages at:id put:cnt + 1.
+"/ ].
+ (Delay forSeconds:0.5) wait.
+ self updateStatus.
+ ].
+ (Delay forSeconds:0.5) wait.
+ self updateList.
+ ]
+ ]
+ ] forkAt:(Processor userSchedulingPriority + 1).
+ updateProcess name:'monitor [' ,
+ Processor activeProcess id printString ,
+ '] update'.
+ "
+ raise my own priority
+ "
+ Processor activeProcess priority:(Processor userSchedulingPriority + 2)
].
waitColor := waitColor on:device.
runColor := runColor on:device.
suspendedColor := suspendedColor on:device.
-!
-
-mapped
- super mapped.
- self updateStatus.
- self updateList.
-! !
-
-!ProcessMonitor methodsFor:'destroying'!
-
-destroy
- updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor removeTimedBlock:listUpdateBlock.
- ] ifFalse:[
- updateProcess terminate
- ].
- super destroy
! !
!ProcessMonitor methodsFor:'private'!
@@ -230,77 +356,124 @@
sel := listView selection.
sel isNil ifTrue:[^ self].
(sel isKindOf:Collection) ifTrue:[
- sel do:[:n |
- nr := n - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
- ]
+ sel do:[:n |
+ nr := n - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := processes at:nr.
- p notNil ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - 2. "for headlines"
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := processes at:nr.
+ p notNil ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
-"/ self updateStatus.
-"/ self updateList.
!
selectedProcessesSend:aSelector
self selectedProcessesDo:[:p |
- p perform:aSelector
- ]
+ p perform:aSelector
+ ].
+ self updateView.
! !
!ProcessMonitor methodsFor:'menu actions'!
-hideDead:aBoolean
- hideDead := aBoolean
+terminateProcess
+ self selectedProcessesSend:#terminate
!
debugProcess
self selectedProcessesDo:[:p |
Debugger openOn:p
]
-!
+!
-inspectProcess
- self selectedProcessesSend:#inspect
-!
+hideDead:aBoolean
+ hideDead := aBoolean
+!
abortProcess
self selectedProcessesDo:[:p |
p interruptWith:[AbortSignal raise]
]
-!
+!
-terminateProcess
- self selectedProcessesSend:#terminate
-!
+inspectProcess
+ self selectedProcessesSend:#inspect
+!
resumeProcess
self selectedProcessesSend:#resume
-!
+!
+
+processMenu
+ |labels selectors m|
+
+ labels := resources array:#(
+"/ hideDead functionality no longer needed;
+"/ since ProcSched knownProcesses only returns living ones
+"/
+"/ '\c hide dead'
+"/ '-'
+ 'inspect'
+ 'debug'
+ '-'
+ 'resume'
+ 'suspend'
+ 'abort'
+ 'terminate'
+ '-'
+ 'raise prio'
+ 'lower prio'
+ ).
+ selectors := #(
+"/ hideDead:
+"/ nil
+ inspectProcess
+ debugProcess
+ nil
+ resumeProcess
+ suspendProcess
+ abortProcess
+ terminateProcess
+ nil
+ raisePrio
+ lowerPrio
+ ).
+
+ updateProcess isNil ifTrue:[
+ labels := (resources array:#('update' '-')) , labels.
+ selectors := #(updateView nil) , selectors
+ ].
+
+ m := PopUpMenu labels:labels
+ selectors:selectors.
+
+"/ m checkToggleAt:#hideDead: put:hideDead.
+
+ ^ m
+!
suspendProcess
self selectedProcessesSend:#suspend
-!
+!
raisePrio
self selectedProcessesDo:[:p |
p priority:(p priority + 1)
]
-!
+!
lowerPrio
self selectedProcessesDo:[:p |
@@ -308,6 +481,24 @@
]
! !
+!ProcessMonitor methodsFor:'destroying'!
+
+destroy
+ updateBlock notNil ifTrue:[
+ Processor removeTimedBlock:updateBlock.
+ Processor removeTimedBlock:listUpdateBlock.
+ ] ifFalse:[
+ updateProcess notNil ifTrue:[updateProcess terminate]
+ ].
+ super destroy
+! !
+
+!ProcessMonitor methodsFor:'queries'!
+
+preferedExtent
+ ^ (font widthOf:self titleLine) + 40 @ 100
+! !
+
!ProcessMonitor methodsFor:'events'!
canHandle:key
@@ -321,136 +512,3 @@
^ super keyPress:key x:x y:y
! !
-!ProcessMonitor methodsFor:'drawing'!
-
-updateList
- "update list of processes"
-
- |newList|
-
- shown ifTrue:[
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- newList := Process allInstances.
- ] ifFalse:[
- newList := ProcessorScheduler knownProcesses asOrderedCollection.
- ].
-
- "sort by id - take care of nil ids of dead processes"
- newList sort:[:p1 :p2 |
- |id1 id2|
-
- (p1 isNil or:[(id1 := p1 id) isNil])
- ifTrue:[true]
- ifFalse:[
- (p2 isNil or:[(id2 := p2 id) isNil])
- ifTrue:[false]
- ifFalse:[id1 < id2]
- ]
- ].
- newList ~= processes ifTrue:[
- processes := WeakArray withAll:newList.
- self updateStatus
- ].
- ].
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:listUpdateBlock afterSeconds:listUpdateDelay
- ].
-!
-
-updateStatus
- "update status display of processes"
-
- |oldList list line dIndex con interrupted|
-
- shown ifTrue:[
- oldList := listView list.
- processes notNil ifTrue:[
- list := OrderedCollection new.
-"/ list add:'id name cpu state prio usedStack totalStack'.
- list add:'id name state prio usedStack totalStack'.
- list add:'--------------------------------------------------------------------------'.
-
- interrupted := Processor interruptedProcess.
-
- dIndex := 1.
- 1 to:processes size do:[:index |
- |aProcess nm st c n|
-
- aProcess := processes at:index.
- aProcess notNil ifTrue:[
- (aProcess id notNil or:[hideDead not]) ifTrue:[
- line := aProcess id printStringPaddedTo:5.
- (nm := aProcess name) isNil ifFalse:[
- nm := nm printString
- ] ifTrue:[
- nm := ' '
- ].
- nm size >= 29 ifTrue:[
- nm := (nm contractTo:28) , ' '
- ] ifFalse:[
- nm := (nm printStringPaddedTo:29).
- ].
- line := line , nm.
-"/ n := cpuUsages at:(aProcess id) ifAbsent:[0].
-"/ n ~~ 0 ifTrue:[
-"/ line := line , ((n * 4) printStringLeftPaddedTo:3)
-"/ ] ifFalse:[
-"/ line := line , ' '
-"/ ].
- st := aProcess state.
- (st == #run
- and:[aProcess == interrupted]) ifTrue:[
- c := ' *'.
- ] ifFalse:[
- c := ' '.
- ].
- line := line , c , (st printStringPaddedTo:9).
- line := line , (aProcess priority printStringLeftPaddedTo:3).
- line := line , (aProcess usedStackSize printStringLeftPaddedTo:11).
- line := line , (aProcess totalStackSize printStringLeftPaddedTo:10).
- line := line , '(' , aProcess numberOfStackSegments printString , ')'.
- (Smalltalk at:#SystemDebugging ifAbsent:[false]) ifTrue:[
- con := aProcess suspendedContext.
- con isNil ifTrue:[
- aProcess == Processor activeProcess ifTrue:[
- con := thisContext
- ]
- ].
- con notNil ifTrue:[
- line := line , ' '.
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- line := line , ' .. '.
- [con sender notNil] whileTrue:[
- con := con sender
- ].
- line := line , ((ObjectMemory addressOf:con) printStringRadix:16).
- ]
- ].
- list add:line.
- processes at:dIndex put:aProcess.
- dIndex := dIndex + 1
- ]
- ].
- ].
- dIndex to:processes size do:[:index |
- processes at:index put:nil
- ]
- ].
- "avoid flicker"
- (oldList notNil and:[oldList size == list size]) ifTrue:[
- list keysAndValuesDo:[:idx :entry |
- (oldList at:idx) ~= entry ifTrue:[
- listView at:idx put:entry
- ]
- ]
- ] ifFalse:[
- listView setList:list.
- "the first two entries cannot be selected"
- listView attributeAt:1 put:#disabled.
- listView attributeAt:2 put:#disabled.
- ]
- ].
- updateBlock notNil ifTrue:[
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
- ]
-! !
--- a/ProjectV.st Sat Mar 25 23:23:29 1995 +0100
+++ b/ProjectV.st Sat Mar 25 23:24:57 1995 +0100
@@ -32,23 +32,24 @@
"launch browsers for all classes/methods which are defined in this package"
self topView withWaitCursorDo:[
- |classes packageName|
+ |classes packageName|
- packageName := myProject packageName.
- classes := myProject classes.
- classes notNil ifTrue:[
- SystemBrowser browseClasses:classes
- title:'classes in package ' , packageName.
+ packageName := myProject packageName.
+ classes := myProject classes.
+ classes notNil ifTrue:[
+ SystemBrowser browseClasses:classes
+ title:'classes in package ' , packageName.
- classes := classes asSet addAll:(classes collect:[:c | c class]).
- ] ifFalse:[
- classes := #()
- ].
- SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
- mthd package = packageName
- and:[(classes includes:cls) not]
- ]
- title:'additional methods in package ' , packageName
+ classes := classes asIdentitySet.
+ classes addAll:(classes collect:[:c | c class]).
+ ] ifFalse:[
+ classes := #()
+ ].
+ SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
+ mthd package = packageName
+ and:[(classes includes:cls) not]
+ ]
+ title:'additional methods in package ' , packageName
]
!
@@ -56,6 +57,7 @@
|box d|
box := FilenameEnterBox new.
+ box directoriesOnly.
box title:(resources string:'Directory of project (fileOuts will go there):').
(d := myProject directory) notNil ifTrue:[
box initialText:d
@@ -82,33 +84,33 @@
projectPackage
self topView withWaitCursorDo:[
- |box p existingPackages|
+ |box p existingPackages|
- existingPackages := Set new.
- Smalltalk allClassesDo:[:aClass |
- |p|
+ existingPackages := Set new.
+ Smalltalk allClassesDo:[:aClass |
+ |p|
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
- Method allInstancesDo:[:aClass |
- |p|
+ (p := aClass package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
+ Method allInstancesDo:[:aClass |
+ |p|
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
+ (p := aClass package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
- box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
- box list:(existingPackages asOrderedCollection sort).
- (p := myProject packageName) notNil ifTrue:[
- box initialText:p
- ].
- box action:[:packageName |
- myProject packageName:packageName
- ].
- box showAtPointer
+ box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
+ box list:(existingPackages asOrderedCollection sort).
+ (p := myProject packageName) notNil ifTrue:[
+ box initialText:p
+ ].
+ box action:[:packageName |
+ myProject packageName:packageName
+ ].
+ box showAtPointer
]
@@ -133,12 +135,12 @@
saveProjectFiles
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- dir := myProject directory.
- (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
- myProject createProjectFiles.
- ]
+ dir := myProject directory.
+ (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
+ myProject createProjectFiles.
+ ]
].
!
@@ -157,19 +159,20 @@
box initialText:(myProject name).
box action:[:newName |
myProject name:newName.
- self setProject:myProject
+ self setProject:myProject.
+ self windowGroup process name:'Project: ' , newName.
].
box showAtPointer
!
buildProject
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- self saveProjectFiles.
- (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
- myProject buildProject.
- ]
+ self saveProjectFiles.
+ (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
+ myProject buildProject.
+ ]
].
!
--- a/ProjectView.st Sat Mar 25 23:23:29 1995 +0100
+++ b/ProjectView.st Sat Mar 25 23:24:57 1995 +0100
@@ -32,23 +32,24 @@
"launch browsers for all classes/methods which are defined in this package"
self topView withWaitCursorDo:[
- |classes packageName|
+ |classes packageName|
- packageName := myProject packageName.
- classes := myProject classes.
- classes notNil ifTrue:[
- SystemBrowser browseClasses:classes
- title:'classes in package ' , packageName.
+ packageName := myProject packageName.
+ classes := myProject classes.
+ classes notNil ifTrue:[
+ SystemBrowser browseClasses:classes
+ title:'classes in package ' , packageName.
- classes := classes asSet addAll:(classes collect:[:c | c class]).
- ] ifFalse:[
- classes := #()
- ].
- SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
- mthd package = packageName
- and:[(classes includes:cls) not]
- ]
- title:'additional methods in package ' , packageName
+ classes := classes asIdentitySet.
+ classes addAll:(classes collect:[:c | c class]).
+ ] ifFalse:[
+ classes := #()
+ ].
+ SystemBrowser browseMethodsWhere:[:cls :mthd :sel |
+ mthd package = packageName
+ and:[(classes includes:cls) not]
+ ]
+ title:'additional methods in package ' , packageName
]
!
@@ -56,6 +57,7 @@
|box d|
box := FilenameEnterBox new.
+ box directoriesOnly.
box title:(resources string:'Directory of project (fileOuts will go there):').
(d := myProject directory) notNil ifTrue:[
box initialText:d
@@ -82,33 +84,33 @@
projectPackage
self topView withWaitCursorDo:[
- |box p existingPackages|
+ |box p existingPackages|
- existingPackages := Set new.
- Smalltalk allClassesDo:[:aClass |
- |p|
+ existingPackages := Set new.
+ Smalltalk allClassesDo:[:aClass |
+ |p|
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
- Method allInstancesDo:[:aClass |
- |p|
+ (p := aClass package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
+ Method allInstancesDo:[:aClass |
+ |p|
- (p := aClass package) notNil ifTrue:[
- existingPackages add:(p asString)
- ]
- ].
+ (p := aClass package) notNil ifTrue:[
+ existingPackages add:(p asString)
+ ]
+ ].
- box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
- box list:(existingPackages asOrderedCollection sort).
- (p := myProject packageName) notNil ifTrue:[
- box initialText:p
- ].
- box action:[:packageName |
- myProject packageName:packageName
- ].
- box showAtPointer
+ box := ListSelectionBox title:'Package (new classes/methods will be put into that):'.
+ box list:(existingPackages asOrderedCollection sort).
+ (p := myProject packageName) notNil ifTrue:[
+ box initialText:p
+ ].
+ box action:[:packageName |
+ myProject packageName:packageName
+ ].
+ box showAtPointer
]
@@ -133,12 +135,12 @@
saveProjectFiles
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- dir := myProject directory.
- (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
- myProject createProjectFiles.
- ]
+ dir := myProject directory.
+ (self confirm:'create source files in: ' , dir , ' ?') ifTrue:[
+ myProject createProjectFiles.
+ ]
].
!
@@ -157,19 +159,20 @@
box initialText:(myProject name).
box action:[:newName |
myProject name:newName.
- self setProject:myProject
+ self setProject:myProject.
+ self windowGroup process name:'Project: ' , newName.
].
box showAtPointer
!
buildProject
self topView withWaitCursorDo:[
- |dir|
+ |dir|
- self saveProjectFiles.
- (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
- myProject buildProject.
- ]
+ self saveProjectFiles.
+ (self confirm:'make object files in: ' , dir , ' ?') ifTrue:[
+ myProject buildProject.
+ ]
].
!
--- a/SBrowser.st Sat Mar 25 23:23:29 1995 +0100
+++ b/SBrowser.st Sat Mar 25 23:24:57 1995 +0100
@@ -12,7 +12,7 @@
'From Smalltalk/X, Version:2.10.4 on 24-feb-1995 at 5:09:20 am'!
-Model subclass:#SystemBrowser
+ApplicationModel subclass:#SystemBrowser
instanceVariableNames:'currentClass currentMethodCategory currentMethod currentSelector
showInstance actualClasslastMethodCategory aspect lockUpdates
autoSearch myLabel acceptClass'
@@ -27,6 +27,8 @@
"Browser configuration;
(values can be changed from your private startup file)"
+ self classResources.
+
"
setting this to false, the removeClass function will remove
classes WITHOUT checking for instances. Otherwise,
@@ -40,7 +42,7 @@
CheckForInstancesWhenRemovingClasses := true
CheckForInstancesWhenRemovingClasses := false
- Browser initialize
+ SystemBrowser initialize
"
! !
@@ -62,7 +64,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.27 1995-03-06 21:25:58 claus Exp $
+$Header: /cvs/stx/stx/libtool/Attic/SBrowser.st,v 1.28 1995-03-25 22:24:49 claus Exp $
"
!
@@ -87,7 +89,7 @@
"launch a standard browser on another display.
Does not work currently - still being developped."
- ^ self newWithLabel:(BrowserView classResources string:'System Browser')
+ ^ self newWithLabel:(self classResources string:'System Browser')
setupBlock:[:browser | browser setupForAll]
on:aDisplay
@@ -1024,7 +1026,6 @@
!
showNoneFound
- Dialog warn:(BrowserView classResources string:'None found').
+ Dialog warn:(self classResources string:'None found').
! !
-SystemBrowser initialize!
--- a/SystemBrowser.st Sat Mar 25 23:23:29 1995 +0100
+++ b/SystemBrowser.st Sat Mar 25 23:24:57 1995 +0100
@@ -12,7 +12,7 @@
'From Smalltalk/X, Version:2.10.4 on 24-feb-1995 at 5:09:20 am'!
-Model subclass:#SystemBrowser
+ApplicationModel subclass:#SystemBrowser
instanceVariableNames:'currentClass currentMethodCategory currentMethod currentSelector
showInstance actualClasslastMethodCategory aspect lockUpdates
autoSearch myLabel acceptClass'
@@ -27,6 +27,8 @@
"Browser configuration;
(values can be changed from your private startup file)"
+ self classResources.
+
"
setting this to false, the removeClass function will remove
classes WITHOUT checking for instances. Otherwise,
@@ -40,7 +42,7 @@
CheckForInstancesWhenRemovingClasses := true
CheckForInstancesWhenRemovingClasses := false
- Browser initialize
+ SystemBrowser initialize
"
! !
@@ -62,7 +64,7 @@
version
"
-$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.27 1995-03-06 21:25:58 claus Exp $
+$Header: /cvs/stx/stx/libtool/SystemBrowser.st,v 1.28 1995-03-25 22:24:49 claus Exp $
"
!
@@ -87,7 +89,7 @@
"launch a standard browser on another display.
Does not work currently - still being developped."
- ^ self newWithLabel:(BrowserView classResources string:'System Browser')
+ ^ self newWithLabel:(self classResources string:'System Browser')
setupBlock:[:browser | browser setupForAll]
on:aDisplay
@@ -1024,7 +1026,6 @@
!
showNoneFound
- Dialog warn:(BrowserView classResources string:'None found').
+ Dialog warn:(self classResources string:'None found').
! !
-SystemBrowser initialize!