--- a/SemaphoreMonitor.st Fri Dec 16 13:00:25 2016 +0100
+++ b/SemaphoreMonitor.st Fri Dec 16 13:00:39 2016 +0100
@@ -11,6 +11,8 @@
"
"{ Package: 'stx:libtool' }"
+"{ NameSpace: Smalltalk }"
+
SystemStatusMonitor subclass:#SemaphoreMonitor
instanceVariableNames:'semaphores'
classVariableNames:''
@@ -38,21 +40,24 @@
documentation
"
- This view shows smalltalks semaphores - a debugging tool.
+ This view shows smalltalk's semaphores - a debugging tool.
+ [disclaimer:]
+ this is one of the oldest tools in the system, written in the early 90's.
+ It does in no way reflect the way GUIs are designed/written these days.
+
[see also:]
- Semaphore SemaphoreSet
- Process ProcessorScheduler
- WindowGroup
- ProcessMonitor
+ Semaphore SemaphoreSet
+ Process ProcessorScheduler
+ WindowGroup
+ ProcessMonitor
[author:]
- Claus Gittinger
+ Claus Gittinger
[start with:]
- SemaphoreMonitor open
+ SemaphoreMonitor open
"
-
! !
!SemaphoreMonitor class methodsFor:'defaults'!
@@ -108,119 +113,119 @@
|oldList list oldSelection newSelection|
shown ifTrue:[
- oldList := listView list.
- oldSelection := listView selectionValue.
- oldSelection notNil ifTrue:[
- oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
- newSelection := OrderedCollection new.
- ].
+ oldList := listView list.
+ oldSelection := listView selectionValue.
+ oldSelection notNil ifTrue:[
+ oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
+ newSelection := OrderedCollection new.
+ ].
- newSemaphoreList notNil ifTrue:[
- semaphores := WeakArray withAll:newSemaphoreList.
- ].
- semaphores notNil ifTrue:[
- list := OrderedCollection new:(semaphores size + 2).
- list add:self titleLine.
- list add:(String new:self titleLine size withAll:$-).
+ newSemaphoreList notNil ifTrue:[
+ semaphores := WeakArray withAll:newSemaphoreList.
+ ].
+ semaphores notNil ifTrue:[
+ list := OrderedCollection new:(semaphores size + self numberOfHeadlines).
+ list add:self titleLine.
+ list add:(String new:self titleLine size withAll:$-).
- semaphores validElementsDo:[:aSemaphore |
- |waiters waitersNames nm id str owner color line count|
+ semaphores validElementsDo:[:aSemaphore |
+ |waiters waitersNames nm id str owner color line count|
- "/ need a copy - it may change while being enumerated
- [
- count := aSemaphore count.
- waiters := aSemaphore waitingProcesses copy.
- ] valueUninterruptably.
+ "/ need a copy - it may change while being enumerated
+ [
+ count := aSemaphore count.
+ waiters := aSemaphore waitingProcesses copy.
+ ] valueUninterruptably.
- str := '' writeStream.
- [
- waiters notNil ifTrue:[
- waiters do:[:aProcess |
- str nextPut:$[.
- aProcess id printOn:str.
- str nextPutAll:' '''.
- str nextPutAll:(aProcess name contractTo:40).
- str nextPutAll:'''<'.
- aProcess priority printOn:str.
- str nextPutAll:'>]'.
- str space.
- ].
- ]
- ] valueUninterruptably.
- waitersNames := str contents.
+ str := '' writeStream.
+ [
+ waiters notNil ifTrue:[
+ waiters do:[:aProcess |
+ str nextPut:$[.
+ aProcess id printOn:str.
+ str nextPutAll:' '''.
+ str nextPutAll:(aProcess name contractTo:40).
+ str nextPutAll:'''<'.
+ aProcess priority printOn:str.
+ str nextPutAll:'>]'.
+ str space.
+ ].
+ ]
+ ] valueUninterruptably.
+ waitersNames := str contents.
- (aSemaphore respondsTo:#name) ifTrue:[
- nm := aSemaphore name.
- nm isNil ifTrue:[
- nm := ''
- ]
- ] ifFalse:[
- nm := ''
- ].
- id := aSemaphore identityHash bitShift:-12.
- owner := aSemaphore lastOwnerId.
- owner isNil ifTrue:[
- owner := ' '
- ] ifFalse:[
- owner := owner printStringLeftPaddedTo:5
- ].
- line := (id printStringPaddedTo:6)
- , ' '
- , ((nm contractTo:25) paddedTo:25)
- , ' '
- , (count printStringLeftPaddedTo:3)
- , ' '
- , owner printString
- , ' '
- , (waiters size printStringLeftPaddedTo:3)
- , ' '
- , waitersNames.
+ (aSemaphore respondsTo:#name) ifTrue:[
+ nm := aSemaphore name.
+ nm isNil ifTrue:[
+ nm := ''
+ ]
+ ] ifFalse:[
+ nm := ''
+ ].
+ id := aSemaphore identityHash bitShift:-12.
+ owner := aSemaphore lastOwnerId.
+ owner isNil ifTrue:[
+ owner := ' '
+ ] ifFalse:[
+ owner := owner printStringLeftPaddedTo:5
+ ].
+ line := (id printStringPaddedTo:6)
+ , ' '
+ , ((nm contractTo:25) paddedTo:25)
+ , ' '
+ , (count printStringLeftPaddedTo:3)
+ , ' '
+ , owner printString
+ , ' '
+ , (waiters size printStringLeftPaddedTo:3)
+ , ' '
+ , waitersNames.
- count > 0 ifTrue:[
- waiters size > 0 ifTrue:[
- "this happens if a low priority process is ready to run but didn't wake up yet"
- color := Color red.
+ count > 0 ifTrue:[
+ waiters size > 0 ifTrue:[
+ "this happens if a low priority process is ready to run but didn't wake up yet"
+ color := Color red.
"/ self beep.
- ] ifFalse:[
- "fine, this semaphore is available"
- color := Color blue.
- ].
- line := line colorizeAllWith:color.
- ] ifFalse:[
- waiters size > 0 ifTrue:[
- line := line colorizeAllWith:Color brown.
- ].
- ].
+ ] ifFalse:[
+ "fine, this semaphore is available"
+ color := Color blue.
+ ].
+ line := line colorizeAllWith:color.
+ ] ifFalse:[
+ waiters size > 0 ifTrue:[
+ line := line colorizeAllWith:Color brown.
+ ].
+ ].
- list add:line.
- oldSelection notNil ifTrue:[
- (oldSelection includes:id) ifTrue:[
- newSelection add:list size.
- ]
- ]
- ].
- ].
- "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.
- ].
- newSelection notNil ifTrue:[
- listView selectWithoutScroll:newSelection
- ].
- listView flush
+ list add:line.
+ oldSelection notNil ifTrue:[
+ (oldSelection includes:id) ifTrue:[
+ newSelection add:list size.
+ ]
+ ]
+ ].
+ ].
+ "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.
+ ].
+ newSelection notNil ifTrue:[
+ listView selectWithoutScroll:newSelection
+ ].
+ listView flush
].
updateBlock notNil ifTrue:[
- Processor removeTimedBlock:updateBlock.
- Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+ Processor removeTimedBlock:updateBlock.
+ Processor addTimedBlock:updateBlock afterSeconds:updateDelay
]
"Modified: / 3.7.1996 / 13:56:01 / stefan"
@@ -274,27 +279,27 @@
sel isNil ifTrue:[^ self].
(sel isKindOf:Collection) ifTrue:[
- sel do:[:n |
- nr := n - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := semaphores at:nr.
- (p notNil and:[p ~~ 0]) ifTrue:[
- aBlock value:p
- ]
- ]
- ]
- ]
+ sel do:[:n |
+ nr := n - self numberOfHeadlines.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := semaphores at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
+ ]
] ifFalse:[
- nr := sel - 2. "for headlines"
- nr notNil ifTrue:[
- nr > 0 ifTrue:[
- p := semaphores at:nr.
- (p notNil and:[p ~~ 0]) ifTrue:[
- aBlock value:p
- ]
- ]
- ]
+ nr := sel - self numberOfHeadlines.
+ nr notNil ifTrue:[
+ nr > 0 ifTrue:[
+ p := semaphores at:nr.
+ (p notNil and:[p ~~ 0]) ifTrue:[
+ aBlock value:p
+ ]
+ ]
+ ]
].
"Created: 23.1.1997 / 03:11:24 / cg"
@@ -352,13 +357,8 @@
!SemaphoreMonitor methodsFor:'queries'!
-preferredExtent
- "return my preferred extent"
-
- ^ (self font widthOf:self titleLine) + 40 @ 250
-
- "Modified: 23.1.1997 / 02:35:01 / cg"
- "Created: 23.1.1997 / 03:04:58 / cg"
+numberOfHeadlines
+ ^ 2
! !
!SemaphoreMonitor methodsFor:'user actions'!
@@ -375,6 +375,6 @@
!SemaphoreMonitor class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.18 2014-04-11 14:22:55 stefan Exp $'
+ ^ '$Header$'
! !