'From etoys3.0 of 7 March 2008 [latest update: #1939] on 28 March 2008 at 4:46:39 pm'!
"Change Set:		DBus-Tools-bf-1
Date:			28 March 2008
Author:			Bert Freudenberg

Name: DBus-Tools-bf.1
Author: bf
Time: 28 March 2008, 4:38:13 pm
UUID: 49b776a4-b1cf-4e71-87de-3ddcfeaf14b9
Ancestors: DBus-Tools-bf.0

- DBusExplorer supports proxy class compiling"!

AbstractHierarchicalList subclass: #DBusExplorer
	instanceVariableNames: 'connection '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Tools'!

!DBusExplorer commentStamp: '<historical>' prior: 0!
Browse DBus services by their introspection data.
!

ListItemWrapper subclass: #DBusExplorerWrapper
	instanceVariableNames: 'service path connection '
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Tools'!

!DBusExplorerWrapper commentStamp: 'bf 2/21/2008 12:47' prior: 0!
service:	'my.service'
path:	'/my/path interface.method()'!


!DBusExplorer methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:44'!
connection
	^connection! !

!DBusExplorer methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:44'!
connection: aDBus
	connection := aDBus! !

!DBusExplorer methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:45'!
getList
	"Get all running DBus services by looking up registered names"

	| list |
	list := (connection getObject:  'org.freedesktop.DBus' path: '/') listNames.
	list := list reject: [:each | each first = $:].
	^list collect: [:each | DBusExplorerWrapper connection: connection service: each path: '/']		

! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 3/3/2008 12:54'!
classTemplateFor: aDBusName
	| className |
	className := (aDBusName copyReplaceAll:  '.' with: ' ') toCamelCase capitalized.
	^'DBusCompiledProxy subclass: #', className,'
	instanceVariableNames: ''''
	classVariableNames: ''''
	poolDictionaries: ''''
	category: ''DBus-Proxies'''
! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 3/27/2008 13:40'!
compileDelegationMethods
	(DBusCompiledProxy classForName: currentSelection service andPath: currentSelection path)
		compileMethodsFrom: currentSelection introspect

! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 3/28/2008 13:04'!
createProxyClass
	| template class |
	template := FillInTheBlankMorph 
		request: 'Create DBus Proxy Class'
		initialAnswer: (self classTemplateFor: currentSelection service)
		centerAt: ActiveHand position
		inWorld: World
		onCancelReturn: nil
		acceptOnCR: true
		answerExtent: 600@180.
	template ifNil: [^self].
	class := Compiler evaluate: template.
	class class
		compile: 'dbusConnection\	^' withCRs, currentSelection connection printString classified: 'accessing';
		compile: 'dbusName\	^' withCRs, currentSelection service printString classified: 'accessing';
		compile: 'dbusPath\	^' withCRs, currentSelection path printString classified: 'accessing'! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 3/28/2008 13:24'!
genericMenu: aMenu 
	| hasMethods isMethod proxyClass |
	currentSelection
		ifNil: [aMenu add: '*nothing selected*' target: self selector: #yourself]
		ifNotNil: [
			proxyClass := DBusCompiledProxy classForName: currentSelection service andPath: currentSelection path.
			hasMethods := currentSelection contents anySatisfy: [:each | each hasContents not].
			isMethod := currentSelection hasContents not.
			isMethod ifFalse: [aMenu add: 'inspect proxy' target: self selector: #inspectSelection].
			proxyClass
				ifNil: [
					hasMethods | isMethod
						ifTrue: [aMenu add: 'create proxy class' target: self selector: #createProxyClass]
						ifFalse: [aMenu add: 'no methods at ', currentSelection path target: self selector: #yourself]]
				ifNotNil: [
					isMethod ifTrue: [aMenu add: 'compile in class ', proxyClass name target: self selector: #compileDelegationMethod].
					hasMethods ifTrue: [aMenu add: 'compile all in class ', proxyClass name target: self selector: #compileDelegationMethods]]].
	^aMenu! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 3/28/2008 13:20'!
inspectSelection
	^currentSelection proxy inspect! !


!DBusExplorer class methodsFor: 'opening' stamp: 'bf 3/28/2008 13:46'!
open
	^self openOn: DBus sessionBus! !

!DBusExplorer class methodsFor: 'opening' stamp: 'bf 3/28/2008 13:47'!
openOn: aDBus
	^(self new connection: aDBus)
		inAWindow openInWorld
! !


!DBusExplorerWrapper methodsFor: 'initialize-release' stamp: 'bf 3/28/2008 13:38'!
connection: aConnection service: serviceName path: pathString
	connection := aConnection.
	service := serviceName.
	path := pathString.! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:38'!
connection
	^connection! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:40'!
contents
	"introspect the current path, answer children (subnodes of current path) and leafs (methods, signals)"

	| node children leafs in out |
	self hasContents ifFalse: [^#()].
	node := (XMLDOMParser parseDocumentFrom: self proxy introspect readStream) elements first.
	children := (node elements select: [:each | each tag = #node])
		collect: [:each | DBusExplorerWrapper
			connection: connection
			service: service
			path: (path='/' ifTrue: [path] ifFalse: [path, '/']), (each attributeAt: 'name')].
	leafs := Array streamContents: [:strm |
		node tagsNamed: #interface do: [:interface |
			interface elements do: [:each |
				(#(method signal) includes: each tag) ifTrue: [
				in := self printParameters: 'in' from: each.
				out := each tag = #signal
					ifTrue: ['SIGNAL']
					ifFalse: [self printParameters: 'out' from: each].
				strm nextPut: (DBusExplorerWrapper
					connection: connection
					service: service
					path: path, ' ', (interface attributeAt: 'name'), '.', (each attributeAt: 'name'), in, ' => ', out)]]]].

	^children, leafs! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/3/2008 18:06'!
fullSelector
	^(path copyAfter: Character space)
		copyUpTo: $(! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/3/2008 18:04'!
path
	^path copyUpTo: Character space! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/28/2008 13:52'!
proxy
	^self connection getObject: self service path: self path! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 3/3/2008 12:49'!
service
	^service! !

!DBusExplorerWrapper methodsFor: 'private' stamp: 'bf 3/27/2008 13:25'!
printParameters: direction from: aNode
	"given introspection data for a method or signal node, format a parameter list like (name:type, name:type)"

	^String streamContents: [:strm |
		strm nextPut: $(.
		(aNode elements select: [:each | each tag = #arg and: [(each attributeAt: 'direction' ifAbsent: ['in']) = direction]])
			do: [:arg | strm nextPutAll: (arg attributeAt: 'name' ifAbsent: ['']), ':', (arg attributeAt: 'type')]
			separatedBy: [strm nextPutAll: ', '].
		strm nextPut: $)].! !


!DBusExplorerWrapper class methodsFor: 'instance creation' stamp: 'bf 3/28/2008 13:40'!
connection: aConnection service: serviceName path: pathString
	^self new connection: aConnection service: serviceName path: pathString! !

DBusExplorerWrapper class removeSelector: #service:path:!
DBusExplorerWrapper removeSelector: #arguments:from:!
DBusExplorerWrapper removeSelector: #sendDBusMessage:!
DBusExplorerWrapper removeSelector: #service:path:!
ListItemWrapper subclass: #DBusExplorerWrapper
	instanceVariableNames: 'connection service path'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Tools'!
DBusExplorer removeSelector: #sendDBusMessage:!
AbstractHierarchicalList subclass: #DBusExplorer
	instanceVariableNames: 'connection'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Tools'!