'From etoys3.0 of 7 March 2008 [latest update: #2053] on 17 July 2008 at 8:52:11 pm'!
"Change Set:		DBus-Objects-bf-4
Date:			17 July 2008
Author:			Bert Freudenberg

Name: DBus-Objects-bf.4
Author: bf
Time: 17 July 2008, 8:42:44 pm
UUID: 073d0b46-bc92-4eea-9dda-be31d8ec48d8
Ancestors: DBus-Objects-bf.3

- make sure mainLoop does not block on handlers
- add signal handling to proxies
- fix instance creation of concrete proxy subclass"!


!DBus methodsFor: 'mainloop' stamp: 'bf 7/8/2008 17:14'!
handleMessage: msg
	| actions |
	self logDebug: self asString, ' received ', msg asString.
	"take care to not call handlers while accessLock is held, they could block"
	actions := OrderedCollection new.
	accessLock critical: [
		matchHandlers keysAndValuesDo: [:match :handler |
			(match matches: msg) ifTrue: [
				actions add: [handler valueWithArguments: {msg}] fixTemps]].
		msg isReplyOrError
			ifTrue: [(replyHandlers removeKey: msg replySerial ifAbsent: [])
				ifNotNilDo: [:handler | actions add: [handler handleReplyOrError: msg] fixTemps]]
			ifFalse: [actions add: [self dispatchMessage: msg] fixTemps]].
	actions do: [:action |	action	forkNamed: self printString, ' handler ', msg serial asString]! !


!DBusProxy methodsFor: 'signals' stamp: 'bf 7/7/2008 21:58'!
assertDBusSignature: aString matchesSelector: aSymbol
	self assert: [
		| argCount |
		argCount := aSymbol occurrencesOf: $:.
		DBusArgument signaturesIn: aString
			do: [:sig | argCount := argCount - 1].
		argCount = 0]! !

!DBusProxy methodsFor: 'signals' stamp: 'bf 7/11/2008 19:48'!
onDBusSignal: memberString interface: interfaceString send: aSelector to: anObject 
	| match |
	match := DBusMatch new.
	match path: self dbusPath.
	memberString ifNotNil: [match member: memberString].
	interfaceString ifNotNil: [match interface: interfaceString].
	aSelector ifNil: [self dbusConnection removeMatch: match. ^match].
	self dbusConnection
		onMatch: match
		do: [:msg | anObject perform: aSelector
			withEnoughArguments:
				(msg arguments collect: [:each | each fromDBusArgument: self])].
	^match! !

!DBusProxy methodsFor: 'signals' stamp: 'bf 7/11/2008 19:53'!
onDBusSignal: memberString interface: interfaceString signature: signatureString send: aSelector to: anObject 

	signatureString ifNotNil: [
		self assertDBusSignature: signatureString matchesSelector: aSelector].
	^self onDBusSignal: memberString interface: interfaceString send: aSelector to: anObject 
! !

!DBusProxy methodsFor: 'signals' stamp: 'bf 7/7/2008 21:38'!
onDBusSignal: interfaceAndMember send: aSelector to: anObject 
	| member interface dot |
	dot := interfaceAndMember lastIndexOf: $..
	dot > 0
		ifTrue: [member := interfaceAndMember allButFirst: dot.
			interface := interfaceAndMember first: dot-1]
		ifFalse: [member := interfaceAndMember.
			interface := nil].
	^self onDBusSignal: member
		interface: interface
		send: aSelector to: anObject ! !


!DBusProxy class methodsFor: 'instance creation' stamp: 'bf 7/7/2008 15:28'!
connection: aDBusConnection busName: aNameString objectPath: aPathString
	"Create a CompiledProxy for the given name and path, or a GenericProxy"
	| proxyClass |
	proxyClass := self isAbstract
		ifFalse: [self]
		ifTrue: [(DBusCompiledProxy classForName: aNameString andPath: aPathString)
			ifNil: [DBusGenericProxy]].
	^proxyClass new
		setConnection: aDBusConnection
		busName: aNameString
		objectPath: aPathString.
! !

!DBusProxy class methodsFor: 'testing' stamp: 'bf 7/7/2008 15:28'!
isAbstract
	^self == DBusProxy! !


!DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 7/11/2008 20:10'!
compileMethodsAndSignalsFrom: introspectionString
	| node |
	node := (XMLDOMParser parseDocumentFrom: introspectionString readStream) elements first.
	node tagsNamed: #interface do: [:interface |
		(interface attributeAt: 'name') = 'org.freedesktop.DBus.Introspectable' ifFalse: [
			interface tagsNamed: #method do: [:method |
				self compileMethod: (method attributeAt: 'name')
					interface: (interface attributeAt: 'name')
					in: (self parameters: 'in' from: method)
					out: (self parameters: 'out' from: method)].
			interface tagsNamed: #signal do: [:signal |
				self compileSignal: (signal attributeAt: 'name')
					interface: (interface attributeAt: 'name')
					in: (self parameters: 'in' from: signal)]]].

! !

!DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 7/11/2008 20:36'!
compileSignal: memberString interface: interfaceString in: inParams
	| overwriteOkay newSource oldSource |
	overwriteOkay := '"Automatically generated"'.
	newSource := String streamContents: [:strm |
		strm nextPutAll: 'on', (self underscoreToCamelCase: memberString) capitalized,
			'Send: aSelector to: anObject'.
		strm crtab; nextPutAll: overwriteOkay.
		strm crtab; nextPutAll: '^self onDBusSignal: '; print: memberString; 
			crtab: 2; nextPutAll: 'interface: '; print: interfaceString;
			crtab: 2; nextPutAll: 'signature: '''.
		inParams do: [:param | strm nextPutAll: param value].
		strm nextPutAll: '''';
			crtab: 2; nextPutAll: 'send: aSelector to: anObject'].

	oldSource := (self sourceCodeAt: (Parser new parseSelector: newSource) asSymbol
		ifAbsent: [overwriteOkay]) asString.
	(oldSource ~= newSource and: [oldSource includesSubString: overwriteOkay])
		ifTrue: [self compile: newSource classified: interfaceString].! !

!DBusCompiledProxy class methodsFor: 'testing' stamp: 'bf 7/7/2008 15:29'!
isAbstract
	^self == DBusCompiledProxy! !

DBusCompiledProxy class removeSelector: #compileMethodsFrom:!