Tcl Source Code

Check-in [d3a2b330e6]
Login

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

Overview
Comment:* mods for NaTk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | ferrieux-nacl
Files: files | file ages | folders
SHA1: d3a2b330e6a23f7e78c2dc9a986b3d236ac1d506
User & Date: colin 2011-05-05 07:51:49
Context
2011-05-05
07:53
* added initial NaTk support - won't yet run without symlink lib/ to Wub/ and symlink to tcllib/ check-in: 5262e46c8d user: colin tags: ferrieux-nacl
07:51
* mods for NaTk check-in: d3a2b330e6 user: colin tags: ferrieux-nacl
2011-05-04
23:49
* defined an init script with TclSetPreInitScript() which permits us to use [interp create] without ... check-in: 4701561332 user: colin tags: ferrieux-nacl
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to nacl/demo/loader.js.

37
38
39
40
41
42
43

44
45
46
47
48
49
50
51
52
53
    } catch(err) {
	//printf("JS-err:"+err);
	setTimeout('tcl("::nacl::bgerror,"'+ err + ',' + t + ')',0);
    }
}

function tcl() {

    try {
        //printf.apply(this, arguments);
	t = tclModule.evall.apply(tclModule, arguments);
        //printf("ret:", t);
    } catch (err) {
	//printf("JS-err:", err);
	setTimeout('tcl("::nacl::bgerror,"'+ err + ',' + t + ')',0);
    }

    try {







>


|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
    } catch(err) {
	//printf("JS-err:"+err);
	setTimeout('tcl("::nacl::bgerror,"'+ err + ',' + t + ')',0);
    }
}

function tcl() {
    var t;
    try {
        //printf.apply(this, arguments);
        t = tclModule.evall.apply(tclModule, arguments);
        //printf("ret:", t);
    } catch (err) {
	//printf("JS-err:", err);
	setTimeout('tcl("::nacl::bgerror,"'+ err + ',' + t + ')',0);
    }

    try {

Changes to nacl/init.natcl.

51
52
53
54
55
56
57




58
59
60
61
62
63
64
	}
    }

    proc bgerror {args} {
        printf "### BGERROR: [join $args]\n# [info errorstack]"
        js "alert([jsquote "BGERROR: [join $args]"])"
    }





    proc wrap {s} {
        variable JS ""
        variable hooks
        if {[catch {
            uplevel #0 $s
            foreach x $hooks {uplevel #0 $x}







>
>
>
>







51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
	}
    }

    proc bgerror {args} {
        printf "### BGERROR: [join $args]\n# [info errorstack]"
        js "alert([jsquote "BGERROR: [join $args]"])"
    }

    proc alert {args} {
        js "alert([jsquote [join $args]])"
    }

    proc wrap {s} {
        variable JS ""
        variable hooks
        if {[catch {
            uplevel #0 $s
            foreach x $hooks {uplevel #0 $x}
82
83
84
85
86
87
88





89
90
91
92
93


















94
95
96
97
98
99
100
            bgerror "$err ($eo)"
        }
        return $JS
    }

    # start - natcl module has been loaded with the following args
    proc start {args} {





        set ::argv $args
        if {[dict exists $args verbose]} {
            variable verbose [dict get $args verbose]
        }
    }



















    namespace export -clear *
    namespace ensemble create -subcommands {}
}

# Coro-based [source] necessary for bootstrapping
proc ::source {url} {







>
>
>
>
>
|




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







86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
            bgerror "$err ($eo)"
        }
        return $JS
    }

    # start - natcl module has been loaded with the following args
    proc start {args} {
        set defaults {
            verbose 0
            script script
            toplevel toplevel
        }
        set ::argv [dict merge $defaults $args]
        if {[dict exists $args verbose]} {
            variable verbose [dict get $args verbose]
        }
    }

    namespace export -clear *
    namespace ensemble create -subcommands {}
}

namespace eval ::dom {
    # Delayed DOM-setting through the tclDo() trampoline
    proc put {element inner} {
        nacl js "$element.innerHTML=[nacl jsquote $inner]"
    }

    # get - get element's innerHTML and pass it to callback
    proc get {element args} {
        if {![llength $args]} {
            set args [info coroutine]
        }
        nacl js "tcl('[join $args "', '"]', '{'+$element.innerHTML+'}')"
    }

    namespace export -clear *
    namespace ensemble create -subcommands {}
}

# Coro-based [source] necessary for bootstrapping
proc ::source {url} {