}

# Make sure a new interface on a path has all the necessary parts so it
# doesn't need to be checked every time.
#
proc dbus::dbif::create {bus path intf} {
    variable dbif
    if {![info exists dbif($bus|$path|$intf)]} {
	set dbif($bus|$path|$intf) \
	  [dict create methods {} signals {} properties {}]
    }
}

# Parse a DBus method or signal argument specification list
#
proc dbus::dbif::args {list {thing Argument}} {

    create $bus $path $intf
    set args [args $in]
    dict update args signature sig args inargs {}
    set args [args $out]
    dict update args signature ret args outargs {}
    set dict [dict create command $cmd interp $int signature $ret \
      in $inargs out $outargs meta $meta async $async]
    dict set dbif($bus|$path|$intf) methods $name,$sig $dict
}

# Release the information stored for a message
#
proc dbus::dbif::expire {id} {
    variable info
    if {[info exists info($id)]} {

proc dbus::dbif::async {opts} {
    return [expr {[dict exists $opts -async] && \
      [string is true -strict [dict get $opts -async]]}]
}

proc dbus::dbif::vartrace {op bus path intf name} {
    variable dbif; variable trace
    dict with dbif($bus|$path|$intf) properties $name {
	if {[dict exists $meta Property.EmitsChangedSignal]} {
	    set ecs [dict get $meta Property.EmitsChangedSignal]
	} else {
	    set ecs true
	}
	if {$op eq "add"} {
	    if {!$trace} return

proc dbus::dbif::changedsignal {state} {
    variable trace
    if {!$state == !$trace} return
    set trace [expr {!!$state}]
    set op [lindex {remove add} $trace]
    variable dbif
    foreach n [array names dbif] {
	lassign [split $n |] bus path intf
	foreach name [dict keys [dict get $dbif($n) properties]] {
	    vartrace $op $bus $path $intf $name
	}
    }
}

# Determine the number of arguments from signatures

	    # Internal signal present on all buses
	    if {$id eq "PropertiesChanged"} {
		# Stop automatic signalling of changed properties
		changedsignal 0
		# The code may have messed with the path
		set opath ""
	    }
	    set old [array names dbif *|$opath|$ointf]
	} else {
	    set old [list $obus|$opath|$ointf]
	}
	foreach o $old {
	    set sigs [dict get $dbif($o) signals]
    	    dict set dbif($o) signals \
	      [lsearch -all -inline -exact -not $sigs $id]
	}
    }
    set signal($id) [dict merge $dict [args $in] [dict create meta $meta]]
    dict lappend dbif($bus|$path|$intf) signals $id
    return $id
}

# Define a property that may be accessed through the DBus
#
proc dbus::dbif::property {args} {
    variable defaults; variable dbif

    }
    set args [args [list $name] Property]
    set name [lindex [dict get $args args] 0]
    set sig [lindex [dict get $args signature] 0]
    create $bus $path $intf

    # Remove any old trace
    if {[dict exists $dbif($bus|$path|$intf) properties $name]} {
	vartrace remove $bus $path $intf $name
    }

    if {$body ne ""} {
	set ns [getns $interp]
	set cmd [list apply [list $name $body $ns]]
    } else {
	set cmd ""
    }
    set dict [dict create variable $var access $op signature $sig \
      command $cmd interp $interp meta $meta]
    dict set dbif($bus|$path|$intf) properties $name $dict

    # Setup a variable trace for readable properties
    vartrace add $bus $path $intf $name
    if {$interp ne {}} {
	interp alias $interp ::dbus::dbif::propchg {} ::dbus::dbif::propchg
    }
}

# Define how to handle a method call
#
proc dbus::dbif::method {args} {
    variable defaults
    dict with defaults {}; set meta {}; set async 0; set opts {}
    cmdline opt arg {path cmd {in ""} {out ""} {interp ""} body} $args {
        -bus: {set bus [buscheck $arg]}
        -interface: {set intf [intfcheck $arg]}
	-attributes: {set meta [metacheck $arg]}
	-async {set async 1}
	-details {lappend opts -details}
    }
    namecheck $cmd
    set args {}
    set info {{}}
    foreach n $in {
	if {[llength $n] == 2 || [llength $info] > 1} {
	    lassign $n arg default

	}
    }
    set ns [getns $interp]
    set code [list apply [list [linsert $args 0 msgid] $body $ns]]
    foreach n $info {
	define $bus $path $intf $cmd $code $interp $n $out $meta $async
    }
    dbus method $bus {*}$opts $path $intf.$cmd [list dbus::dbif::methods $bus]
}

# Generate a signal according to an earlier specification
#
proc dbus::dbif::generate {id args} {
    variable signal
    if {![info exists signal($id)]} {

    dict with defaults {}
    cmdline opt arg {path} $args {
	-bus: {set bus [buscheck $arg]}
	-interface: {set intf [intfcheck $arg]}
    }
    pathcheck $path
    if {$path eq "/"} {set pat /*} else {set pat $path/*}
    set paths [array names dbif $bus|$pat|$intf]
    if {[info exists dbif($bus|$path|$intf)]} {lappend paths $bus|$path|$intf}
    foreach n $paths {
	foreach sig [dict get $dbif($n) signals] {
	    unset -nocomplain signal($sig)
	}
	unset dbif($n)
    }
}

########################################################################
# Property access
########################################################################

# Handle a property set request
#
proc dbus::dbif::propset {bus data intf name arg} {
    variable dbif; variable info
    set path [dict get $data path]
    if {![info exists dbif($bus|$path|$intf)]} {
    	dbuserr interface $bus $path $intf
    }
    if {![dict exists $dbif($bus|$path|$intf) properties $name]} {
    	dbuserr property $bus $path $intf $name
    }
    set dict [dict get $dbif($bus|$path|$intf) properties $name]
    dict with dict {
	if {$access ni {write readwrite}} {
    	    dbuserr access $bus $path $intf $name write
	}
	# Strip off the two string arguments for interface and name
	set sig [dict get $data signature]
	set sig [string range $sig 2 end]

}

# Handle a property get request
#
proc dbus::dbif::propget {bus data intf name} {
    variable dbif; variable info
    set path [dict get $data path]
    if {![info exists dbif($bus|$path|$intf)]} {
	dbuserr interface $bus $path $intf
    }
    if {![dict exists $dbif($bus|$path|$intf) properties $name]} {
	dbuserr property $bus $path $intf $name
    }
    set op [dict get $dbif($bus|$path|$intf) properties $name access]
    if {$op ni {read readwrite}} {dbuserr access $bus $path $intf $name read}
    set interp [dict get $dbif($bus|$path|$intf) properties $name interp]
    set var [dict get $dbif($bus|$path|$intf) properties $name variable]
    if {[interp eval $interp [list uplevel #0 [list info exists $var]]]} {
	set sig [dict get $dbif($bus|$path|$intf) properties $name signature]
	set dest [dict get $data sender]
	set serial [dict get $data serial]
	set value [interp eval $interp [list uplevel #0 [list set $var]]]
	dbus return $bus -signature $sig $dest $serial $value
    } else {
	dbuserr propunset $bus $path $intf $name
    }
    return -async 1
}

# Handle a property getall request
#
proc dbus::dbif::propdump {bus data {intf ""} args} {
    variable dbif; variable info
    set path [dict get $data path]
    if {![info exists dbif($bus|$path|$intf)]} {
	dbuserr interface $bus $path $intf
    }
    if {![dict exists $dbif($bus|$path|$intf) properties]} {return {}}
    set rc {}
    dict for {n v} [dict get $dbif($bus|$path|$intf) properties] {
	set interp [dict get $v interp]
	set var [dict get $v variable]
	if {[interp eval $interp [list uplevel #0 [list info exists $var]]]} {
	    set sig [dict get $v signature]
	    set value [interp eval $interp [list uplevel #0 [list set $var]]]
	    lappend rc $n [list $sig $value]
	}

	return -code return
    }
    variable dbif
    set change {}
    set invalid {}
    dict for {key op} [dict get $propchg $bus $path $intf] {
	if {$op eq "write"} {
	    set info [dict get $dbif($bus|$path|$intf) properties $key]
	    dict with info {}
	    set value [interp eval $interp \
	      [list uplevel #0 [list set $variable]]]
	    dict set change $key [list $signature $value]
	} else {
	    lappend invalid $key
	}

#
proc dbus::dbif::propchgsignal {} {
    variable propchg
    dict for {bus data} $propchg {
	dict for {path dict} $data {
	    dict for {intf chg} $dict {
		if {[dict size $chg] > 0} {
		    # Ignore values that do not match the signature
		    catch {generate PropertiesChanged $path $intf $bus}
		}
	    }
	}
    }
    # All changes have been reported
    set propchg {}
}

########################################################################
# Introspection procedures
########################################################################

proc dbus::dbif::node {bus path} {
    variable dbif
    set list [array names dbif $bus|$path|*]
    if {[llength $list] == 0} {
	if {$path eq "/"} {set pat /*} else {set pat $path/*}
	if {[llength [array names dbif $bus|$pat|*]] == 0} return
    }
    set rc {
	{<!DOCTYPE node PUBLIC\
	  "-//freedesktop//DTD D-BUS Object Introspection 1.0//EN"}
	{"http://www.freedesktop.org/standards/dbus/1.0/introspect.dtd">}
    }
    lappend rc {<node>}
    set ilist {}
    foreach n $list {
	set i [lindex [split $n |] 2]
	set dict $dbif($n)
	if {[info exists dbif($bus||$i)]} {
	    dict with dict {
		set std $dbif($bus||$i)
		set methods [dict merge [dict get $std methods] $methods]
		set properties \
		  [dict merge [dict get $std properties] $properties]
		foreach n [dict get $std signals] {
		    if {$n ni $signals} {lappend signals $n}
		}
	    }
	}
	lappend rc [interface $i $dict "  "]
	lappend ilist $i
    }
    foreach n [array names dbif $bus||*] {
	set i [lindex [split $n |] 2]
	if {$i ni $ilist} {
	    lappend rc [interface $i $dbif($n) "  "]
	}
    }
    set parent(/) {}
    foreach n [array names dbif $bus|$path*] {
	set p [lindex [split $n |] 1]
	if {$p eq "/"} continue
	set dir /
	foreach d [lrange [split $p /] 1 end] {
	    lappend parent($dir) $d
	    if {$dir eq "/"} {set dir ""}
	    append dir / $d
	    lappend parent($dir)

proc dbus::dbif::standard {bus} {
    variable dbif
    variable trace
    set arg1 [dict create in {interface_name s property_name s} out {value v} meta {}]
    set arg2 [dict create in {interface_name s property_name s value v} out {} meta {}]
    set arg3 [dict create in {interface_name s} out {values a{sv}} meta {}]
    create $bus "" org.freedesktop.DBus.Properties
    dict set dbif($bus||org.freedesktop.DBus.Properties) methods \
      [dict create Get,ss $arg1 Set,ssv $arg2 GetAll,sa{sv} $arg3]
    if {$trace} {
	dict set dbif($bus||org.freedesktop.DBus.Properties) signals \
	  [list PropertiesChanged]
    }
    create $bus "" org.freedesktop.DBus.Introspectable
    dict set dbif($bus||org.freedesktop.DBus.Introspectable) methods \
      [dict create Introspect, [dict create in {} out {xml_data s} meta {}]]
}

########################################################################
# DBus message handlers
########################################################################

proc dbus::dbif::introspect {bus data args} {
    return [node $bus [dict get $data path]]
}

proc dbus::dbif::methods {bus data args} {
    variable timeout; variable msgid; variable info; variable dbif
    dict with data {}
    if {![info exists dbif($bus|$path|$interface)]} {
	dbuserr interface $bus $path $interface
    }
    if {![dict exists $dbif($bus|$path|$interface) \
      methods $member,$signature]} {
	dbuserr member $bus $path $interface $member $signature
    }
    set dict [dict get $dbif($bus|$path|$interface) methods $member,$signature]

    set id message[incr msgid]
    # Allow 25 seconds for the application to provide a response
    set afterid [after $timeout [list dbus::dbif::expire $id]]
    set info($id) [dict merge $data [dict create bus $bus afterid $afterid]]
    # Store a copy of the information needed to provide a response. This
    # information would otherwise be lost if the code deletes its own path.

}

void DBus_CallResult(DBusPendingCall *pending, void *data)
{
   DBusMessage *msg;
   Tcl_CallData *dataPtr = data;
   Tcl_DBusEvent *evPtr;

   msg = dbus_pending_call_steal_reply(pending);
   /* free the pending message handle */
   dbus_pending_call_unref(pending);
   /* Allocate a DBus event structure and copy in some basic data */
   evPtr = (Tcl_DBusEvent *) ckalloc(sizeof(Tcl_DBusEvent));
   evPtr->interp = dataPtr->interp;
   evPtr->script = dataPtr->script;
   evPtr->conn = dataPtr->conn;
   /* Fill in the rest of the DBus event structure */
   evPtr->event.proc = DBus_EventHandler;
   evPtr->msg = msg;
   /* Don't send a reply on the reply */
   evPtr->flags = dataPtr->flags | DBUSFLAG_NOREPLY;
   Tcl_QueueEvent((Tcl_Event *) evPtr, TCL_QUEUE_TAIL);
   /* Free the DBus handler data structure */
   ckfree(data);
}





void DBus_DeleteTimeoutToken(void *data)

{

   Tcl_DeleteTimerHandler((Tcl_TimerToken) data);




}

void DBus_RemoveTimeout(DBusTimeout *timeout, void *data)
{
   Tcl_TimerToken token;

   /* Multiple removes are harmless */
   token = dbus_timeout_get_data(timeout);
   Tcl_DeleteTimerHandler(token);
}

void DBus_Timeout(ClientData timeout)
{
   Tcl_TimerToken token;

   dbus_timeout_handle(timeout);
   /* Must restart the timeout until it is removed */
   token = Tcl_CreateTimerHandler(dbus_timeout_get_interval(timeout),
				  DBus_Timeout, timeout);
   dbus_timeout_set_data(timeout, token, DBus_DeleteTimeoutToken);
}

dbus_bool_t DBus_AddTimeout(DBusTimeout *timeout, void *data)
{
   Tcl_TimerToken token;

   /* The same timeout value may be added multiple times */
   token = dbus_timeout_get_data(timeout);
   if (token != NULL)
     Tcl_DeleteTimerHandler(token);

   token = Tcl_CreateTimerHandler(dbus_timeout_get_interval(timeout),
				   DBus_Timeout, timeout);
   dbus_timeout_set_data(timeout, token, DBus_DeleteTimeoutToken);
   return TRUE;
}

void DBus_ToggleTimeout(DBusTimeout *timeout, void *data)
{
   if (dbus_timeout_get_enabled(timeout)) {
      DBus_AddTimeout(timeout, data);
   } else {
      DBus_RemoveTimeout(timeout, data);
   }
}

/*
 *----------------------------------------------------------------------
 * 
 * DBus_ListListeners
 *	Check if a signal handler is registered by the specified interpreter