Diff

Differences From Artifact [a663422b2a]:

To Artifact [13347466c1]:


84
85
86
87
88
89
90

91
92
93
94
95
96
97
...
465
466
467
468
469
470
471

























472
473
474
475
476
477
478
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
...
640
641
642
643
644
645
646
647







648
649
650
651
652
653
654

	proc _ccommand {handle tclCommand argList body} {
		upvar #0 $handle state

		set tclCommand [lookupNamespace $tclCommand]

		set cSymbol [cleanname [namespace tail $tclCommand]]


		lappend state(procs) $tclCommand [list $cSymbol]

		foreach {clientData interp objc objv} $argList {}
		set cArgList "ClientData $clientData, Tcl_Interp *$interp, int $objc, Tcl_Obj *CONST $objv\[\]"

		append state(code) "int $cSymbol\($cArgList) {\n$body\n}\n"
................................................................................

	proc _go {handle {outputOnly 0}} {
		variable dir

		upvar #0 $handle state

		set code ""


























		foreach {macroName macroVal} $state(add_macros) {
			append code "#define [string trim "$macroName $macroVal"]\n"
		}

		append code $state(code) "\n"

................................................................................
				set packageVersion [lindex $state(package) 1]
				if {$packageVersion == ""} {
					set packageVersion "0"
				}

				append code "int [string totitle $packageName]_Init(Tcl_Interp *interp) \{\n"
				append code "#ifdef USE_TCL_STUBS\n"
				append code "  if (Tcl_InitStubs(interp, TCL_VERSION, 0) == 0L) \{\n"
				append code "    return TCL_ERROR;\n"
				append code "  \}\n"
				append code "#endif\n"

				if {[info exists state(procs)] && [llength $state(procs)] > 0} {
					foreach {procname cname_obj} $state(procs) {
						set cname [lindex $cname_obj 0]
................................................................................
		# Cleanup
		rename $handle ""
		unset $handle
	}
}

proc ::tcc4tcl::checkname {n} {expr {[regexp {^[a-zA-Z0-9_]+$} $n] > 0}}
proc ::tcc4tcl::cleanname {n} {regsub -all {[^a-zA-Z0-9_]+} $n _}








proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	set handle [::tcc4tcl::new]
	$handle cproc $name $adefs $rtype $body
	return [$handle go]
}








>







 







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







 







|







 







|
>
>
>
>
>
>
>







84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
...
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
...
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
...
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687

	proc _ccommand {handle tclCommand argList body} {
		upvar #0 $handle state

		set tclCommand [lookupNamespace $tclCommand]

		set cSymbol [cleanname [namespace tail $tclCommand]]
		set cSymbol [cleanname $tclCommand]

		lappend state(procs) $tclCommand [list $cSymbol]

		foreach {clientData interp objc objv} $argList {}
		set cArgList "ClientData $clientData, Tcl_Interp *$interp, int $objc, Tcl_Obj *CONST $objv\[\]"

		append state(code) "int $cSymbol\($cArgList) {\n$body\n}\n"
................................................................................

	proc _go {handle {outputOnly 0}} {
		variable dir

		upvar #0 $handle state

		set code ""

		if {$outputOnly} {
			append code "#if 0\n"
			set seenCLIPaths [list]
			foreach path $state(add_inc_path) {
				if {$path in $seenCLIPaths} {
					continue
				}
				lappend seenCLIPaths $path
				append code "CLI:-I${path}\n"
			}
			set seenCLIPaths [list]
			foreach path $state(add_lib_path) {
				if {$path in $seenCLIPaths} {
					continue
				}
				lappend seenCLIPaths $path
				append code "CLI:-L${path}\n"
			}
			unset seenCLIPaths
			foreach path $state(add_lib) {
				append code "CLI:-l${path}\n"
			}
			append code "#endif\n"
		}

		foreach {macroName macroVal} $state(add_macros) {
			append code "#define [string trim "$macroName $macroVal"]\n"
		}

		append code $state(code) "\n"

................................................................................
				set packageVersion [lindex $state(package) 1]
				if {$packageVersion == ""} {
					set packageVersion "0"
				}

				append code "int [string totitle $packageName]_Init(Tcl_Interp *interp) \{\n"
				append code "#ifdef USE_TCL_STUBS\n"
				append code "  if (Tcl_InitStubs(interp, TCL_PATCH_LEVEL, 0) == 0L) \{\n"
				append code "    return TCL_ERROR;\n"
				append code "  \}\n"
				append code "#endif\n"

				if {[info exists state(procs)] && [llength $state(procs)] > 0} {
					foreach {procname cname_obj} $state(procs) {
						set cname [lindex $cname_obj 0]
................................................................................
		# Cleanup
		rename $handle ""
		unset $handle
	}
}

proc ::tcc4tcl::checkname {n} {expr {[regexp {^[a-zA-Z0-9_]+$} $n] > 0}}
proc ::tcc4tcl::cleanname {n} {
	set n [regsub -all {[^a-zA-Z0-9_]+} $n _]
	if {[string index $n 0] eq "_"} {
		set n "tcc4tcl${n}"
	}

	return $n
}

proc ::tcc4tcl::cproc {name adefs rtype {body "#"}} {
	set handle [::tcc4tcl::new]
	$handle cproc $name $adefs $rtype $body
	return [$handle go]
}