'From etoys3.0 of 7 March 2008 [latest update: #2028] on 20 June 2008 at 12:46:41 am'!
"Change Set:		dbusExplorer-bf
Date:			20 June 2008
Author:			Bert Freudenberg

Name: DBus-Tools-bf.2
Author: bf
Time: 19 June 2008, 9:33:28 pm
UUID: 9739cd29-d202-4e78-ae12-5a54bab5e973
Ancestors: DBus-Tools-bf.1

- show sessionBus and systemBus
- invoke a method directly by menu or keyboard
- register in world menu"!

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

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


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

	^{DBus systemBus. DBus sessionBus}
		collect: [:each | DBusExplorerWrapper connection: each service: '' path: '']		

! !

!DBusExplorer methodsFor: 'opening' stamp: 'bf 6/17/2008 17:17'!
notInAWindow
	| listMorph |

	(listMorph := SimpleHierarchicalListMorph 
		on: self
		list: #getList
		selected: #getCurrentSelection
		changeSelected: #noteNewSelection:
		menu: #genericMenu:
		keystroke: #keyStroke:).
	listMorph autoDeselect: false.
     ^ listMorph! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 6/16/2008 17:01'!
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	
				ifTrue: [aMenu add: 'invoke method' target: self selector: #invokeSelection]
				ifFalse: [aMenu add: 'inspect proxy' target: self selector: #inspectSelection].
			hasMethods ifTrue:
				[proxyClass
					ifNil: [aMenu add: 'create proxy class' target: self selector: #createProxyClass]
					ifNotNil: [aMenu add: 'compile all in class ', proxyClass name target: self selector: #compileDelegationMethods]]].
	^aMenu! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 6/16/2008 16:53'!
invokeSelection
	^currentSelection invokeMethod! !

!DBusExplorer methodsFor: 'menus' stamp: 'bf 6/17/2008 17:20'!
keyStroke: aCharacter
	({Character space. Character cr} includes: aCharacter)
		ifTrue: [self invokeSelection]! !


!DBusExplorer class methodsFor: 'opening' stamp: 'bf 6/17/2008 16:24'!
open
	^self new inAWindow openInWorld
! !

!DBusExplorer class methodsFor: 'class initialization' stamp: 'bf 6/17/2008 16:26'!
initialize
	TheWorldMenu registerOpenCommand: {'DBus Explorer'. {self. #open}}! !

!DBusExplorer class methodsFor: 'class initialization' stamp: 'bf 6/17/2008 16:28'!
unload
	TheWorldMenu unregisterOpenCommand: 'DBus Explorer'! !


!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 6/16/2008 16:34'!
asString
	"display only the 'interesting' part of the path"

	^self hasContents
		ifTrue: [path size <= 1
			ifTrue: [service
				ifEmpty: [connection asString]
				ifNotEmpty: [service]]
			ifFalse: [path copyAfterLast: $/]]
		ifFalse: [path copyAfter: Character space]! !

!DBusExplorerWrapper methodsFor: 'accessing' stamp: 'bf 6/16/2008 16:37'!
contents
	"introspect the current path, answer children (subnodes of current path) and leafs (methods, signals)"

	| node children leafs in out |
	self hasContents ifFalse: [^#()].
	service isEmpty ifTrue: [
		^((connection getObject:  'org.freedesktop.DBus' path: '/') listNames
			reject: [:each | each first = $:])
				collect: [:each | DBusExplorerWrapper connection: connection service: each path: '/']].
	node := (XMLDOMParser parseDocumentFrom: self proxy introspect readStream) firstTagNamed: #node .
	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: 'private' stamp: 'bf 6/17/2008 19:44'!
invokeMethod
	| args result argName argSig argValue |
	args := ((path copyAfter: $() copyUpTo: $)) findTokens: $,.
	args := args collect: [:each |
			argName := each copyUpTo: $:.
			argSig := each copyAfter: $:.
			argValue := FillInTheBlank request:
				argName, 	' (', (DBusArgument nameOfSignature: argSig), ')'.
			argValue ifNil: [^self].
			argValue := argSig = 's'
				ifTrue: [argValue]
				ifFalse: [Compiler evaluate: argValue].
			DBusArgument value: argValue signature: argSig].
	"execute in background since the dbus call blocks which might interfere with a synchronous server in this same image"
	[
		result := self proxy dbusPerform: self fullSelector withArguments: args.
		result ifNotNil: [WorldState addDeferredUIMessage: [result inspect]]
	] fork! !

DBusExplorer initialize!
DBusExplorer class removeSelector: #openOn:!
DBusExplorer removeSelector: #connection!
DBusExplorer removeSelector: #connection:!
AbstractHierarchicalList subclass: #DBusExplorer
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'DBus-Tools'!