Planet
navi homePPSaboutscreenshotsdownloaddevelopmentforum

source: code/trunk/data/tcl/irk/lib/irkctcptcl.tcl @ 7721

Last change on this file since 7721 was 5781, checked in by rgrieder, 15 years ago

Reverted trunk again. We might want to find a way to delete these revisions again (x3n's changes are still available as diff in the commit mails).

  • Property svn:eol-style set to native
File size: 1.3 KB
Line 
1# irkctcptcl.tcl:
2#
3# This file implements the IRK CTCP TCL protocol:
4
5namespace eval ::irk {
6
7    # This procedure sets up a safe interpreter for the channel in which
8    # the CTCP TCL action occurs:
9
10    proc setupInterp {token chan} {
11        variable state
12
13        if {![info exists state($token,$chan,interp)]} {
14            catch {interp delete ${token}${chan}}
15            set state($token,$chan,interp) [safe::interpCreate ${token}${chan}]
16            safe::loadTk $state($token,$chan,interp)
17        }
18        if {![interp exists ${token}${chan}]} {
19            set state($token,$chan,interp) [safe::interpCreate ${token}${chan}]
20            safe::loadTk $state($token,$chan,interp)
21        }
22    }
23
24    # This procedure dispatches the Tcl command embedded within the
25    # CTCP TCL action to the associated interpreter:
26
27    proc RECV,CTCP,TCL {token nick user comm dest action rest} {
28        variable state
29
30        puts stderr "Tcl command is: $rest [llength $rest]"
31        setupInterp $token $dest
32        interp eval $state($token,$dest,interp) [::join $rest]
33    }
34
35    # This procedure dispatches the Tcl command embedded within the
36    # CTCP TCL action for local execution on the issuer's side:
37
38    proc RECV,CTCP,TCL,LOCAL {token nick user comm dest action rest} {
39        variable state
40
41        puts stderr "Tcl command is: $rest [llength $rest]"
42        setupInterp $token $dest
43        interp eval $state($token,$dest,interp) $rest
44    }
45}
Note: See TracBrowser for help on using the repository browser.