'From etoys3.0 of 7 March 2008 [latest update: #1939] on 28 March 2008 at 4:48:22 pm'! "Change Set: DBus-Objects-bf-1 Date: 28 March 2008 Author: Bert Freudenberg Name: DBus-Objects-bf.1 Author: bf Time: 28 March 2008, 4:25:26 pm UUID: b803ae36-4a71-4b68-b769-592ecef84b4e Ancestors: - initial version - still uses mainloop of OLPC Etoys SugarLauncher"! DBusConnection subclass: #DBus instanceVariableNames: 'exported imported' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBus commentStamp: '' prior: 0! I am a DBus connection. FIXME: I do not have a mainloop yet, instead I reuse the OLPC Etoys SugarLauncher mainloop (DBus sessionBus getObject: 'org.gnome.ScreenSaver' path: '/') SetActive: true! Object subclass: #DBusMethod instanceVariableNames: 'interface selector inSignature outSignature' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! Object subclass: #DBusObject instanceVariableNames: 'dbusConnection dbusName dbusParent dbusChildren' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBusObject commentStamp: '' prior: 0! I am an object exposed on the DBus. Most of my methods are prefixed with 'dbus' to minimize selector space polution for subclasses.! Object subclass: #DBusProxy instanceVariableNames: 'connection busName objectPath' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBusProxy commentStamp: 'bf 3/27/2008 16:31' prior: 0! I am a proxy for an object on the DBus. You can send messages using #dbusPerform: and its variants. ! DBusProxy subclass: #DBusCompiledProxy instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBusCompiledProxy commentStamp: '' prior: 0! I'm the superclass for a DBus proxy with delegation methods compiled by introspection. ! DBusCompiledProxy subclass: #DBusDaemon instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBusDaemon commentStamp: '' prior: 0! I am an example compiled proxy for the 'org.freedesktop.DBus' service. My methods were generated like this: DBusDaemon compileMethodsFrom: DBusDaemon current introspect I can, e.g., list names on the DBus: DBusDaemon current listNames! DBusProxy subclass: #DBusGenericProxy instanceVariableNames: 'methods' classVariableNames: '' poolDictionaries: '' category: 'DBus-Objects'! !DBusGenericProxy commentStamp: '' prior: 0! I am a generic proxy for an object on the DBus. You can simply send Smalltalk messages to me that I intercept via #doesNotUnderstand: and forward to the DBus.! DBusCompiledProxy class instanceVariableNames: 'current'! !DBus methodsFor: 'exporting' stamp: 'bf 3/14/2008 19:54'! export: aDBusObject at: aPathString exported ifNil: [exported := DBusObject new dbusConnection: self]. exported dbusAdd: aDBusObject path: (aPathString findTokens: '/').! ! !DBus methodsFor: 'importing' stamp: 'bf 3/14/2008 19:54'! getObject: aNameString path: aPathString ^DBusProxy connection: self busName: aNameString objectPath: aPathString! ! !DBus methodsFor: 'FIXME' stamp: 'bf 3/28/2008 15:16'! sendDBusMessage: aMessage "FIXME: provide proper dbus main loop" | mainloopProvider | mainloopProvider := Smalltalk at: #SugarLauncher ifPresent: [:sugarLauncher | sugarLauncher current ensureDBus]. ^mainloopProvider sendDBusMessage: aMessage timeout: 3! ! !DBusArgument methodsFor: '*dbus-objects' stamp: 'bf 3/28/2008 16:06'! fromDBusArgument: sender "XXX refactor into subclasses" self isBasicType ifTrue: [ type = DBusArgument objectPath ifTrue: [^sender dbusProxyForPath: value]. ^value]. ^type caseOf: { [DBusArgument struct] -> [value collect: [:ea | ea fromDBusArgument: sender]]. [DBusArgument dictEntry] -> [(value key fromDBusArgument: sender) -> (value value fromDBusArgument: sender)]. [DBusArgument array] -> [| arr | signature = 'ay' ifTrue: [^value]. arr := value collect: [:ea | ea fromDBusArgument: sender]. self containedSignature first =${ ifTrue: [arr as: Dictionary] ifFalse: [arr]]. [DBusArgument variant] -> [value fromDBusArgument: sender] } ! ! !DBusMethod methodsFor: 'accessing' stamp: 'bf 2/27/2008 16:48'! fullSelector ^interface, '.', selector! ! !DBusMethod methodsFor: 'accessing' stamp: 'bf 2/25/2008 15:25'! inSignature ^inSignature! ! !DBusMethod methodsFor: 'accessing' stamp: 'bf 2/25/2008 15:24'! interface ^interface! ! !DBusMethod methodsFor: 'accessing' stamp: 'bf 2/25/2008 15:25'! outSignature ^outSignature! ! !DBusMethod methodsFor: 'accessing' stamp: 'bf 2/25/2008 15:25'! selector ^selector! ! !DBusMethod methodsFor: 'initialize-release' stamp: 'bf 4/27/2007 19:41'! initializeFromSpecString: aString | p | interface := aString copyUpToLast: $.. selector := aString copyFrom: interface size+2 to: (p := aString indexOf: $<)-1. inSignature := aString copyFrom: p+1 to: (p := aString indexOf: $>)-1. outSignature := aString copyFrom: p+1 to: aString size.! ! !DBusMethod methodsFor: 'initialize-release' stamp: 'bf 2/25/2008 14:19'! setInterface: anInterface selector: aSelector in: anInSignature out: anOutSignature interface := anInterface. selector := aSelector. inSignature := anInSignature. outSignature := anOutSignature. ! ! !DBusMethod methodsFor: 'printing' stamp: 'bf 4/27/2007 19:53'! printOn: aStream aStream nextPutAll: interface; nextPut: $.; nextPutAll: selector; nextPut: $<; nextPutAll: inSignature; nextPut: $>; nextPutAll: outSignature! ! !DBusMethod methodsFor: 'printing' stamp: 'bf 5/16/2007 18:37'! printXMLOn: xml xml startTag: 'method'; attribute: 'name' value: selector; endTag. #('in' 'out') with: {inSignature. outSignature} do: [:direction :signature | signature do: [:type | xml startTag: 'arg'; attribute: 'direction' value: direction; attribute: 'type' value: type asString; endEmptyTag: 'arg']]. xml endTag: 'method'.! ! !DBusMethod class methodsFor: 'instance creation' stamp: 'bf 5/16/2007 18:27'! fromSpecString: aString ^self new initializeFromSpecString: aString! ! !DBusMethod class methodsFor: 'instance creation' stamp: 'bf 2/25/2008 14:20'! interface: anInterface selector: aSelector in: anInSignature out: anOutSignature ^self new setInterface: anInterface selector: aSelector in: anInSignature out: anOutSignature! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/25/2007 21:09'! asDBusArgument ^ DBusArgument objectPath: self dbusPath! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 2/21/2008 13:47'! dbusAdd: aDBusObject path: aPathArray aPathArray size > 1 ifTrue: [ ^(dbusChildren at: aPathArray first ifAbsentPut: [DBusObject parent: self name: aPathArray first]) dbusAdd: aDBusObject path: aPathArray allButFirst]. aDBusObject dbusParent: self name: aPathArray last. dbusChildren at: aDBusObject dbusName put: aDBusObject! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/21/2007 17:45'! dbusConnection ^dbusConnection! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/21/2007 17:48'! dbusConnection: aDBusConnection dbusConnection := aDBusConnection! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:39'! dbusInterfaces "self basicNew dbusInterfaces" | interfaces | interfaces := Set new. self dbusMethodSpecsAndSelectorsDo: [:spec :selector | interfaces add: (spec copyUpToLast: $.)]. ^interfaces ! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/16/2007 18:29'! dbusInterface: interface methodsDo: aBlock self dbusMethodSpecsAndSelectorsDo: [:spec :selector | interface = (spec copyUpToLast: $.) ifTrue: [aBlock value: (DBusMethod fromSpecString: spec)]] ! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/16/2007 18:28'! dbusMethodSpecsAndSelectorsDo: aBlock ^self class selectorsAndMethodsDo: [:sel :meth | (meth numLiterals >= 2 and: [(meth literalAt: 1) == #dbusMethod:]) ifTrue: [aBlock value: (meth literalAt: 2) value: sel]] ! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:40'! dbusMethods "Answer a Dictionary mapping DBus selectors to DBusMethod instances" | methods method | methods := Dictionary new. self dbusMethodSpecsAndSelectorsDo: [:spec :selector | method := DBusMethod fromSpecString: spec. methods at: method selector put: method]. ^methods ! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/16/2007 17:45'! dbusName ^dbusName! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/21/2007 18:05'! dbusParent ^dbusParent! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/21/2007 18:07'! dbusPath ^dbusParent ifNil: ['/'] ifNotNil: [ dbusParent dbusParent ifNil: ['/', dbusName] ifNotNil: [dbusParent dbusPath, '/', dbusName]]! ! !DBusObject methodsFor: 'accessing' stamp: 'bf 5/25/2007 21:08'! dbusType ^DBusArgument objectPath ! ! !DBusObject methodsFor: 'exporting' stamp: 'bf 2/29/2008 11:45'! dbusMethod: formatString "This message marks a method to be exported on the DBus. It must be the first message-send in the method. The format is 'interface.methodoutSignature' where both inSignature and outSignature may be empty" ^self ! ! !DBusObject methodsFor: 'initialize-release' stamp: 'bf 5/21/2007 17:53'! dbusParent: aDBusObject name: aString dbusConnection := aDBusObject dbusConnection. dbusParent := aDBusObject. dbusName := aString. ! ! !DBusObject methodsFor: 'initialize-release' stamp: 'bf 5/21/2007 17:53'! initialize dbusName := ''. dbusParent := nil. dbusChildren := Dictionary new. ! ! !DBusObject methodsFor: 'introspection' stamp: 'bf 5/16/2007 18:08'! introspect self dbusMethod: 'org.freedesktop.DBus.Introspectable.Introspect<>s'. ^String streamContents: [:stream | | xml | stream nextPutAll: ''. xml := XMLWriter on: stream. xml startTag: 'node'; endTag. dbusChildren do: [:child | xml startTag: 'node'; attribute: 'name' value: child dbusName; endEmptyTag: 'node']. self dbusInterfaces do: [:interface | xml startTag: 'interface'; attribute: 'name' value: interface; endTag. self dbusInterface: interface methodsDo: [:method | method printXMLOn: xml]. xml endTag: 'interface' ]. xml endTag: 'node']! ! !DBusObject methodsFor: 'printing' stamp: 'bf 5/21/2007 17:56'! printOn: aStream aStream print: self class; nextPut: $(; nextPutAll: self dbusPath; nextPut: $)! ! !DBusObject class methodsFor: 'instance creation' stamp: 'bf 5/21/2007 17:46'! parent: aDBusObject name: aString ^self new dbusParent: aDBusObject name: aString! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:54'! asDBusArgument ^ DBusArgument objectPath: self dbusPath! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 3/27/2008 17:27'! dbusConnection ^connection! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:55'! dbusMethods "Answer a Dictionary mapping DBus selectors to DBusMethod instances" | introspected types | introspected := Dictionary new. (XMLDOMParser parseDocumentFrom: self introspect readStream) elements first tagsNamed: #interface do: [:interface | interface tagsNamed: #method do: [:method | types := {'in' -> String new writeStream. 'out' -> String new writeStream} as: Dictionary. method tagsNamed: #arg do: [:arg | (types at: (arg attributeAt: 'direction')) nextPutAll: (arg attributeAt: 'type')]. introspected at: (method attributeAt: 'name') put: (DBusMethod interface: (interface attributeAt: 'name') selector: (method attributeAt: 'name') in: (types at: 'in') contents out: (types at: 'out') contents)]]. ^introspected ! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:53'! dbusName ^busName! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:54'! dbusPath ^objectPath! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:54'! dbusProxyForPath: aPath ^DBusProxy connection: self dbusConnection busName: self dbusName objectPath: aPath! ! !DBusProxy methodsFor: 'accessing' stamp: 'bf 5/25/2007 20:14'! dbusType ^DBusArgument objectPath ! ! !DBusProxy methodsFor: 'calling' stamp: 'bf 2/26/2008 11:31'! dbusPerform: interfaceAndSelector "interfaceAndSelector is either 'interface.selector' or simply 'selector'. In the latter case, the interface will be inferred by introspection." ^self dbusPerform: interfaceAndSelector withArguments: #()! ! !DBusProxy methodsFor: 'calling' stamp: 'bf 2/25/2008 14:53'! dbusPerform: selectorString interface: interfaceString ^self dbusPerform: selectorString interface: interfaceString withArguments: #() ! ! !DBusProxy methodsFor: 'calling' stamp: 'bf 3/28/2008 15:15'! dbusPerform: selectorString interface: interfaceString withArguments: argumentArray | msg reply | msg := DBusMessageMethodCall destination: self dbusName path: self dbusPath interface: interfaceString selector: selectorString. argumentArray do: [:each | msg addArgument: each]. reply := self dbusConnection sendDBusMessage: msg. reply arguments size = 0 ifTrue: [^nil]. reply arguments size = 1 ifTrue: [^reply arguments first fromDBusArgument: self]. ^reply arguments collect: [:each | each fromDBusArgument: self]! ! !DBusProxy methodsFor: 'calling' stamp: 'bf 2/29/2008 11:48'! dbusPerform: interfaceAndSelector withArguments: argumentArray "interfaceAndSelector is either 'interface.selector' or simply 'selector'." | selector interface dot | dot := interfaceAndSelector lastIndexOf: $.. dot > 0 ifTrue: [selector := interfaceAndSelector allButFirst: dot. interface := interfaceAndSelector first: dot-1. interface isEmpty ifTrue: [interface := nil]] ifFalse: [ selector := interfaceAndSelector. interface := nil. self useIntrospection ifTrue: [ self dbusMethods at: selector ifPresent: [:method | interface := method interface]]]. ^self dbusPerform: selector interface: interface withArguments: argumentArray ! ! !DBusProxy methodsFor: 'org.freedesktop.DBus.Introspectable' stamp: 'bf 3/27/2008 18:01'! introspect "Returns aString 's'." "Automatically generated - not regenerated in subclasses" ^self dbusPerform: 'Introspect' interface: 'org.freedesktop.DBus.Introspectable'! ! !DBusProxy methodsFor: 'initialize-release' stamp: 'bf 2/25/2008 13:42'! setConnection: aDBusConnection busName: aNameString objectPath: aPathString connection := aDBusConnection. busName := aNameString. objectPath := aPathString. ! ! !DBusProxy methodsFor: 'testing' stamp: 'bf 2/29/2008 11:29'! useIntrospection ^false! ! !DBusCompiledProxy methodsFor: 'accessing' stamp: 'bf 3/14/2008 19:27'! dbusConnection ^super dbusConnection ifNil: [self class dbusConnection]! ! !DBusCompiledProxy methodsFor: 'accessing' stamp: 'bf 3/14/2008 19:25'! dbusName ^super dbusName ifNil: [self class dbusName]! ! !DBusCompiledProxy methodsFor: 'accessing' stamp: 'bf 3/14/2008 19:26'! dbusPath ^super dbusPath ifNil: [self class dbusPath]! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! addMatch: aString "Returns nothing." "Automatically generated" ^self dbusPerform: 'AddMatch' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 16:06'! getConnectionSELinuxSecurityContext: aString "Returns anArrayOfBytes 'ay'." "Automatically generated" ^self dbusPerform: 'GetConnectionSELinuxSecurityContext' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! getConnectionUnixProcessID: aString "Returns anUint32 'u'." "Automatically generated" ^self dbusPerform: 'GetConnectionUnixProcessID' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! getConnectionUnixUser: aString "Returns anUint32 'u'." "Automatically generated" ^self dbusPerform: 'GetConnectionUnixUser' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! getNameOwner: aString "Returns aString 's'." "Automatically generated" ^self dbusPerform: 'GetNameOwner' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! hello "Returns aString 's'." "Automatically generated" ^self dbusPerform: 'Hello' interface: 'org.freedesktop.DBus'! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 16:06'! listActivatableNames "Returns anArrayOfStrings 'as'." "Automatically generated" ^self dbusPerform: 'ListActivatableNames' interface: 'org.freedesktop.DBus'! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 16:06'! listNames "Returns anArrayOfStrings 'as'." "Automatically generated" ^self dbusPerform: 'ListNames' interface: 'org.freedesktop.DBus'! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 16:06'! listQueuedOwners: aString "Returns anArrayOfStrings 'as'." "Automatically generated" ^self dbusPerform: 'ListQueuedOwners' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! nameHasOwner: aString "Returns aBoolean 'b'." "Automatically generated" ^self dbusPerform: 'NameHasOwner' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! releaseName: aString "Returns anUint32 'u'." "Automatically generated" ^self dbusPerform: 'ReleaseName' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! reloadConfig "Returns nothing." "Automatically generated" ^self dbusPerform: 'ReloadConfig' interface: 'org.freedesktop.DBus'! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! removeMatch: aString "Returns nothing." "Automatically generated" ^self dbusPerform: 'RemoveMatch' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! requestName: aString with: anUint32 "Returns anUint32 'u'." "Automatically generated" ^self dbusPerform: 'RequestName' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'. DBusArgument value: anUint32 signature: 'u'.}! ! !DBusDaemon methodsFor: 'org.freedesktop.DBus' stamp: 'bf 3/27/2008 15:52'! startServiceByName: aString with: anUint32 "Returns anUint32 'u'." "Automatically generated" ^self dbusPerform: 'StartServiceByName' interface: 'org.freedesktop.DBus' withArguments: { DBusArgument value: aString signature: 's'. DBusArgument value: anUint32 signature: 'u'.}! ! !DBusGenericProxy methodsFor: 'accessing' stamp: 'bf 2/29/2008 11:35'! dbusMethods ^methods ifNil: [ methods := [super dbusMethods] ifError: [Dictionary new]]! ! !DBusGenericProxy methodsFor: 'calling' stamp: 'bf 2/29/2008 11:20'! doesNotUnderstand: aMessage aMessage selector first isLetter ifFalse: [^super doesNotUnderstand: aMessage]. ^self dbusPerform: (aMessage selector copyUpTo: $:) withArguments: aMessage arguments ! ! !DBusGenericProxy methodsFor: 'testing' stamp: 'bf 2/29/2008 11:29'! useIntrospection ^true! ! !DBusProxy class methodsFor: 'instance creation' stamp: 'bf 3/27/2008 17:41'! connection: aDBusConnection busName: aNameString objectPath: aPathString "Create a CompiledProxy for the given name and path, or a GenericProxy" | proxyClass | proxyClass := DBusCompiledProxy classForName: aNameString andPath: aPathString. proxyClass ifNil: [proxyClass := DBusGenericProxy]. ^proxyClass new setConnection: aDBusConnection busName: aNameString objectPath: aPathString. ! ! !DBusCompiledProxy class methodsFor: 'accessing' stamp: 'bf 3/14/2008 19:40'! classForName: aDBusName andPath: aDBusPath self allSubclassesDo: [:cls | (cls handlesDBusName: aDBusName andPath: aDBusPath) ifTrue: [^cls]]. ^nil! ! !DBusCompiledProxy class methodsFor: 'accessing' stamp: 'bf 3/14/2008 19:27'! dbusConnection ^ self subclassResponsibility ! ! !DBusCompiledProxy class methodsFor: 'accessing' stamp: 'bf 3/3/2008 17:55'! dbusName ^ self subclassResponsibility ! ! !DBusCompiledProxy class methodsFor: 'accessing' stamp: 'bf 3/3/2008 17:56'! dbusPath ^ self subclassResponsibility ! ! !DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 3/27/2008 15:51'! compileMethodsFrom: 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)]]]. ! ! !DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 3/27/2008 15:50'! compileMethod: memberString interface: interfaceString in: inParams out: outParams | overwriteOkay newSource oldSource | overwriteOkay := '"Automatically generated"'. newSource := String streamContents: [:strm | strm nextPutAll: (self underscoreToCamelCase: memberString). inParams withIndexDo: [:param :i | i=1 ifTrue: [strm nextPutAll: ': '] ifFalse: [strm nextPutAll: ' with: ']. strm nextPutAll: param key]. strm crtab; nextPutAll: '"Returns '. outParams ifEmpty: [strm nextPutAll: 'nothing'] ifNotEmpty: [ outParams do: [:p | strm nextPutAll: p key, ' ''', p value, ''''] separatedBy: [strm nextPutAll: ' and ']]. strm nextPutAll: '."'. strm crtab; nextPutAll: overwriteOkay. strm crtab; nextPutAll: '^self dbusPerform: '; print: memberString; nextPutAll: ' interface: '; print: interfaceString. inParams isEmpty ifFalse: [ strm nextPutAll: ' withArguments: {'. inParams do: [:param | strm crtab: 2; nextPutAll: 'DBusArgument value: '; nextPutAll: param key; nextPutAll: ' signature: '; print: param value; nextPutAll: '.']. strm nextPutAll: '}']]. 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: 'compiling' stamp: 'bf 3/27/2008 16:16'! parameterFromSignature: aSignature | parameter | parameter := DBusArgument nameOfSignature: aSignature. ^parameter first isVowel ifTrue: ['an', parameter] ifFalse: ['a', parameter].! ! !DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 3/27/2008 16:16'! parameters: direction from: aNode "given introspection data for a method or signal node, format a parameter list like #(nameA->type nameB->type)" | parameters signatures parameter signature | parameters := OrderedCollection new. signatures := OrderedCollection new. aNode tagsNamed: #arg do: [:arg | (arg attributeAt: 'direction' ifAbsent: ['in']) = direction ifTrue: [ signature := arg attributeAt: 'type'. parameter := arg attributeAt: 'name' ifAbsent: [nil]. parameter := parameter ifNil: [self parameterFromSignature: signature] ifNotNil: [(self underscoreToCamelCase: parameter), (DBusArgument nameOfSignature: signature)]. [self allInstVarNames includes: parameter] whileTrue: [ parameter := parameter first isVowel ifTrue: ['an', parameter capitalized] ifFalse: ['a', parameter capitalized]]. signatures add: signature. parameters add: parameter]]. "Append letter if necessary for uniqueness" parameters := parameters withIndexCollect: [:param :i | (parameters occurrencesOf: param) = 1 ifTrue: [param] ifFalse: [param copyWith: (Character value: $A asInteger+ ((parameters first: i) occurrencesOf: param)-1)]]. ^parameters with: signatures collect: [:p :s | p -> s]! ! !DBusCompiledProxy class methodsFor: 'compiling' stamp: 'bf 3/28/2008 13:16'! underscoreToCamelCase: aString | s | s := aString. (s allSatisfy: [:c | c = $_ or: [c isUppercase]]) ifTrue: [s := s asLowercase]. ^(s copyReplaceAll: '_' with: ' ') toCamelCase withFirstCharacterDownshifted! ! !DBusCompiledProxy class methodsFor: 'testing' stamp: 'bf 3/27/2008 12:41'! handlesDBusName: aDBusName andPath: aDBusPath ^self dbusName = aDBusName and: [self dbusPath match: aDBusPath]! ! !DBusDaemon class methodsFor: 'accessing' stamp: 'bf 3/27/2008 15:37'! dbusName ^'org.freedesktop.DBus'! ! !DBusDaemon class methodsFor: 'accessing' stamp: 'bf 3/27/2008 15:37'! dbusPath ^'/'! !