Check-in [5a873144ca]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:add dbus upstream changes plus timer handling fix
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 5a873144ca43f6a709f60c344e9fd05afed2fad3
User & Date: chw 2016-11-12 09:17:27
Context
2016-11-12
20:36
add tcl upstream changes check-in: 928f85e1ab user: chw tags: trunk
09:17
add dbus upstream changes plus timer handling fix check-in: 5a873144ca user: chw tags: trunk
2016-11-11
18:02
add tcl upstream changes check-in: b4d4ead073 user: chw tags: trunk
Changes

Changes to undroid/dbus/dbus-intf/dbif.tcl.

122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560

561
562
563
564
565
566
567
...
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
...
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
...
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
...
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
...
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
...
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
...
845
846
847
848
849
850
851

852
853
854
855
856
857
858
859
...
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
...
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
....
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
}

# 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
    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}

    }
    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 $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)
    }
}
................................................................................
########################################################################

# 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
    }
................................................................................
}

# 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} {

		    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.







|
|







 







|







 







|







 







|







 







|

|








|







 







|











|












|





>







 







|







 







|
|







 







|


|


|







 







|


|


|

|
|

|







 







|


|

|







 







|







 







>
|







 







|


|









|

|

|











|
|





|
|







 







|


|



|







 







|


|



|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
...
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
...
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
...
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
...
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
...
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
...
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
...
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
...
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
...
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
...
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
...
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
...
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
...
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
....
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
}

# 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)
    }
}
................................................................................
########################################################################

# 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
    }
................................................................................
}

# 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.

Changes to undroid/dbus/dbus-tcl/dbusEvent.c.

363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
...
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407

408
409
410
411


























412
413





414
415
416
417
418
419
420
}

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;
................................................................................
   /* 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_Timeout(ClientData timeout)
{
   dbus_timeout_handle(timeout);
}

dbus_bool_t DBus_AddTimeout(DBusTimeout *timeout, void *data)
{
   Tcl_TimerToken token;
   
   token = Tcl_CreateTimerHandler(dbus_timeout_get_interval(timeout),
				   DBus_Timeout, timeout);
   dbus_timeout_set_data(timeout, token, NULL);
   return TRUE;
}

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

   token = dbus_timeout_get_data(timeout);
   Tcl_DeleteTimerHandler(token);
}



























void DBus_ToggleTimeout(DBusTimeout *timeout, void *data)
{





}

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







|







 







|

|
<
<
<
<
<
<
<
<
<
<





|
>




>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>







363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
...
382
383
384
385
386
387
388
389
390
391










392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
}

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;
................................................................................
   /* 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