586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
|
set varnames {}
set cargs {}
set cnames {}
set cbody {}
set code {}
# Write wrapper
append cbody "int $wname\(ClientData dummy, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv\[\]) {" "\n"
# if first arg is "Tcl_Interp*", pass it without counting it as a cmd arg
if {[lindex $adefs 0] eq "Tcl_Interp*"} {
lappend cnames ip
lappend cargs [lrange $adefs 0 1]
set adefs [lrange $adefs 2 end]
}
foreach {t n} $adefs {
set types($n) $t
lappend varnames $n
lappend cnames _$n
lappend cargs "$t $n"
|
|
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
|
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
|
set varnames {}
set cargs {}
set cnames {}
set cbody {}
set code {}
# Write wrapper
append cbody "int $wname\(ClientData clientdata, Tcl_Interp *ip, int objc, Tcl_Obj *CONST objv\[\]) {" "\n"
# if first arg is "Tcl_Interp*", pass it without counting it as a cmd arg
while {1} {
if {[lindex $adefs 0] eq "Tcl_Interp*"} {
lappend cnames ip
lappend cargs [lrange $adefs 0 1]
set adefs [lrange $adefs 2 end]
continue
}
if {[lindex $adefs 0] eq "ClientData"} {
lappend cnames clientdata
lappend cargs [lrange $adefs 0 1]
set adefs [lrange $adefs 2 end]
continue
}
break
}
foreach {t n} $adefs {
set types($n) $t
lappend varnames $n
lappend cnames _$n
lappend cargs "$t $n"
|
637
638
639
640
641
642
643
644
645
646
647
648
649
650
|
append code "$rtype2 ${cname}($cargs_str);\n"
}
}
# Create wrapper function
## Supported input types
## Tcl_Interp*
## int
## long
## float
## double
## char*
## Tcl_Obj*
## void*
|
>
|
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
|
append code "$rtype2 ${cname}($cargs_str);\n"
}
}
# Create wrapper function
## Supported input types
## Tcl_Interp*
## ClientData
## int
## long
## float
## double
## char*
## Tcl_Obj*
## void*
|