'From Smalltalk/X, Version:2.10.5 on 26-mar-1995 at 4:21:12 am'!

Model subclass:#Plug
	 instanceVariableNames:'simulatedProtocol'
	 classVariableNames:''
	 poolDictionaries:''
	 category:'Kernel-Objects'
!

!Plug class methodsFor:'documentation'!

version
"
$Header: /cvs/stx/stx/libview2/Plug.st,v 1.3 1995-06-27 02:19:38 claus Exp $
"
!

documentation
"
    A Plug is an objcet which simulates a protocol and evaluates
    a corresponding block when receiving messages.
    Its main use is for the demo doIts, to play the role of a model.
    Plugs are not used in the system and exist as a demo only.
    This class may be changed/removed/replaced without notice.
"
!

examples
"
    |plug|

    plug := Plug new.
    plug respondTo:#foo  with:[Transcript showCr:'received foo'].
    plug respondTo:#foo: with:[:arg | Transcript showCr:'received foo: ', arg printString].

    plug foo.
    plug foo:'some argument'
"
! !

!Plug class methodsFor:'instance creation'!

new
    ^ super basicNew privateInitialize
! !

!Plug methodsFor:'message sending'!

doesNotUnderstand:aMessage
    |block|

    block := simulatedProtocol at:aMessage selector ifAbsent:[].
    block isNil ifTrue:[
	^ super doesNotUnderstand:aMessage
    ].
    ^ block valueWithArguments:(aMessage arguments)
! !

!Plug methodsFor:'queries'!

respondsTo:aSelector
    (simulatedProtocol includesKey:aSelector) ifTrue:[^ true].
    ^ super respondsTo:aSelector
! !

!Plug methodsFor:'protocol definition'!

respondTo:aSelector with:aBlock
    simulatedProtocol at:aSelector put:aBlock
! !

!Plug methodsFor:'initialization'!

privateInitialize
    "this method is NOT called initialize to allow plugging that
     selector ..."

    simulatedProtocol := IdentityDictionary new.
! !