hg/stx-libtool: comparison SemaphoreMonitor.st

equal deleted inserted replaced

-:26ea2eb499bf
+:91a80ba50915
 other person.  No title to or ownership of the software is
 hereby transferred.
 "
 "{ Package: 'stx:libtool' }"
+"{ NameSpace: Smalltalk }"
 SystemStatusMonitor subclass:#SemaphoreMonitor
 	instanceVariableNames:'semaphores'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Monitors-ST/X'
 !
 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
+Semaphore SemaphoreSet
-	Process ProcessorScheduler
+Process ProcessorScheduler
-	WindowGroup
+WindowGroup
-	ProcessMonitor
+ProcessMonitor
 [author:]
-	Claus Gittinger
+Claus Gittinger
 [start with:]
-	SemaphoreMonitor open
+SemaphoreMonitor open
 "
 ! !
 !SemaphoreMonitor class methodsFor:'defaults'!
 defaultLabel
 "update status display of semaphores"
 |oldList list oldSelection newSelection|
 shown ifTrue:[
-	oldList := listView list.
+oldList := listView list.
-	oldSelection := listView selectionValue.
+oldSelection := listView selectionValue.
-	oldSelection notNil ifTrue:[
+oldSelection notNil ifTrue:[
-	    oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
+oldSelection := oldSelection collect:[:line | line asCollectionOfWords first asNumber].
-	    newSelection := OrderedCollection new.
+newSelection := OrderedCollection new.
-	].
+].
-	newSemaphoreList notNil ifTrue:[
+newSemaphoreList notNil ifTrue:[
-	    semaphores := WeakArray withAll:newSemaphoreList.
+semaphores := WeakArray withAll:newSemaphoreList.
-	].
+].
-	semaphores notNil ifTrue:[
+semaphores notNil ifTrue:[
-	    list := OrderedCollection new:(semaphores size + 2).
+list := OrderedCollection new:(semaphores size + self numberOfHeadlines).
-	    list add:self titleLine.
+list add:self titleLine.
-	    list add:(String new:self titleLine size withAll:$-).
+list add:(String new:self titleLine size withAll:$-).
-	    semaphores validElementsDo:[:aSemaphore |
+semaphores validElementsDo:[:aSemaphore |
-		|waiters waitersNames nm id str owner color line count|
+|waiters waitersNames nm id str owner color line count|
-		"/ need a copy - it may change while being enumerated
+"/ need a copy - it may change while being enumerated
-		[
+[
-		    count := aSemaphore count.
+count := aSemaphore count.
-		    waiters := aSemaphore waitingProcesses copy.
+waiters := aSemaphore waitingProcesses copy.
-		] valueUninterruptably.
+] valueUninterruptably.
-		str := '' writeStream.
+str := '' writeStream.
-		[
+[
-		    waiters notNil ifTrue:[
+waiters notNil ifTrue:[
-			waiters do:[:aProcess |
+waiters do:[:aProcess |
-			    str nextPut:$[.
+str nextPut:$[.
-			    aProcess id printOn:str.
+aProcess id printOn:str.
-			    str nextPutAll:' '''.
+str nextPutAll:' '''.
-			    str nextPutAll:(aProcess name contractTo:40).
+str nextPutAll:(aProcess name contractTo:40).
-			    str nextPutAll:'''<'.
+str nextPutAll:'''<'.
-			    aProcess priority printOn:str.
+aProcess priority printOn:str.
-			    str nextPutAll:'>]'.
+str nextPutAll:'>]'.
-			    str space.
+str space.
-			].
+].
-		    ]
+]
-		] valueUninterruptably.
+] valueUninterruptably.
-		waitersNames := str contents.
+waitersNames := str contents.
-		(aSemaphore respondsTo:#name) ifTrue:[
+(aSemaphore respondsTo:#name) ifTrue:[
-		    nm := aSemaphore name.
+nm := aSemaphore name.
-		    nm isNil ifTrue:[
+nm isNil ifTrue:[
-			nm := ''
+nm := ''
-		    ]
+]
-		] ifFalse:[
+] ifFalse:[
-		    nm := ''
+nm := ''
-		].
+].
-		id := aSemaphore identityHash bitShift:-12.
+id := aSemaphore identityHash bitShift:-12.
-		owner := aSemaphore lastOwnerId.
+owner := aSemaphore lastOwnerId.
-		owner isNil ifTrue:[
+owner isNil ifTrue:[
-		    owner := '     '
+owner := '     '
-		] ifFalse:[
+] ifFalse:[
-		    owner := owner printStringLeftPaddedTo:5
+owner := owner printStringLeftPaddedTo:5
-		].
+].
-		line := (id printStringPaddedTo:6)
+line := (id printStringPaddedTo:6)
-			  , ' '
+, ' '
-			  , ((nm contractTo:25) paddedTo:25)
+, ((nm contractTo:25) paddedTo:25)
-			  , ' '
+, ' '
-			  , (count printStringLeftPaddedTo:3)
+, (count printStringLeftPaddedTo:3)
-			  , ' '
+, ' '
-			  , owner printString
+, owner printString
-			  , ' '
+, ' '
-			  , (waiters size printStringLeftPaddedTo:3)
+, (waiters size printStringLeftPaddedTo:3)
-			  , ' '
+, ' '
-			  , waitersNames.
+, waitersNames.
-		count > 0 ifTrue:[
+count > 0 ifTrue:[
-		    waiters size > 0 ifTrue:[
+waiters size > 0 ifTrue:[
-			"this happens if a low priority process is ready to run but didn't wake up yet"
+"this happens if a low priority process is ready to run but didn't wake up yet"
-			color := Color red.
+color := Color red.
 "/                        self beep.
-		    ] ifFalse:[
+] ifFalse:[
-			"fine, this semaphore is available"
+"fine, this semaphore is available"
-			color := Color blue.
+color := Color blue.
-		    ].
+].
-		    line := line colorizeAllWith:color.
+line := line colorizeAllWith:color.
-		] ifFalse:[
+] ifFalse:[
-		    waiters size > 0 ifTrue:[
+waiters size > 0 ifTrue:[
-			line := line colorizeAllWith:Color brown.
+line := line colorizeAllWith:Color brown.
-		    ].
+].
-		].
+].
-		list add:line.
+list add:line.
-		oldSelection notNil ifTrue:[
+oldSelection notNil ifTrue:[
-		    (oldSelection includes:id) ifTrue:[
+(oldSelection includes:id) ifTrue:[
-			newSelection add:list size.
+newSelection add:list size.
-		    ]
+]
-		]
+]
-	    ].
+].
-	].
+].
-	"avoid flicker"
+"avoid flicker"
-	(oldList notNil and:[oldList size == list size]) ifTrue:[
+(oldList notNil and:[oldList size == list size]) ifTrue:[
-	    list keysAndValuesDo:[:idx :entry |
+list keysAndValuesDo:[:idx :entry |
-		(oldList at:idx) ~= entry ifTrue:[
+(oldList at:idx) ~= entry ifTrue:[
-		    listView at:idx put:entry
+listView at:idx put:entry
-		]
+]
-	    ]
+]
-	] ifFalse:[
+] ifFalse:[
-	    listView setList:list.
+listView setList:list.
-	    "the first two entries cannot be selected"
+"the first two entries cannot be selected"
-	    listView attributeAt:1 put:#disabled.
+listView attributeAt:1 put:#disabled.
-	    listView attributeAt:2 put:#disabled.
+listView attributeAt:2 put:#disabled.
-	].
+].
-	newSelection notNil ifTrue:[
+newSelection notNil ifTrue:[
-	    listView selectWithoutScroll:newSelection
+listView selectWithoutScroll:newSelection
-	].
+].
-	listView flush
+listView flush
 ].
 updateBlock notNil ifTrue:[
-	Processor removeTimedBlock:updateBlock.
+Processor removeTimedBlock:updateBlock.
-	Processor addTimedBlock:updateBlock afterSeconds:updateDelay
+Processor addTimedBlock:updateBlock afterSeconds:updateDelay
 ]
 "Modified: / 3.7.1996 / 13:56:01 / stefan"
 "Created: / 14.12.1999 / 20:52:29 / cg"
 "Modified: / 14.12.1999 / 20:53:14 / cg"
 sel := listView selection.
 sel isNil ifTrue:[^ self].
 (sel isKindOf:Collection) ifTrue:[
-	sel do:[:n |
+sel do:[:n |
-	    nr := n - 2.   "for headlines"
+nr := n - self numberOfHeadlines.
-	    nr notNil ifTrue:[
+nr notNil ifTrue:[
-		nr > 0 ifTrue:[
+nr > 0 ifTrue:[
-		    p := semaphores at:nr.
+p := semaphores at:nr.
-		    (p notNil and:[p ~~ 0]) ifTrue:[
+(p notNil and:[p ~~ 0]) ifTrue:[
-		       aBlock value:p
+aBlock value:p
-		    ]
+]
-		]
+]
-	    ]
+]
-	]
+]
 ] ifFalse:[
-	nr := sel - 2.     "for headlines"
+nr := sel - self numberOfHeadlines.
-	nr notNil ifTrue:[
+nr notNil ifTrue:[
-	    nr > 0 ifTrue:[
+nr > 0 ifTrue:[
-		p := semaphores at:nr.
+p := semaphores at:nr.
-		(p notNil and:[p ~~ 0]) ifTrue:[
+(p notNil and:[p ~~ 0]) ifTrue:[
-		   aBlock value:p
+aBlock value:p
-		]
+]
-	    ]
+]
-	]
+]
 ].
 "Created: 23.1.1997 / 03:11:24 / cg"
 !
 "Modified: / 17.6.1998 / 14:17:05 / cg"
 ! !
 !SemaphoreMonitor methodsFor:'queries'!
-preferredExtent
+numberOfHeadlines
-"return my preferred extent"
+^ 2
-^ (self font widthOf:self titleLine) + 40 @ 250
-"Modified: 23.1.1997 / 02:35:01 / cg"
-"Created: 23.1.1997 / 03:04:58 / cg"
 ! !
 !SemaphoreMonitor methodsFor:'user actions'!
 doubleClicked
 ! !
 !SemaphoreMonitor class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/SemaphoreMonitor.st,v 1.18 2014-04-11 14:22:55 stefan Exp $'
+^ '$Header$'
 ! !

changeset 17169	91a80ba50915
parent 14202	336beb9d98f6
child 17215	4a42de8e888a
child 17226	66b523a67429