1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
|
# channel - lets you define your own channels to
# chat with people on a mud.
# When you create a channel a command and alias
# of the channel's name is created.
proc channel {args} {
global _channel
set syntax {
create {{+ name} {? members {}}}
destroy {{+ name}}
names {{? glob *}}
dump {{+ name} {+ file }}
}
switch -exact [check -opts channel $syntax $args] {
create {
set _channel($arg(name)) $arg(members)
interp alias {} $arg(name) {} _channel_cmd $arg(name)
alias set $arg(name) "{$arg(name)} msg \$0"
} destroy {
interp alias {} $arg(name) ""
unset _channel($arg(name))
alias delete -exact -- $arg(name)
} names {
return [array names _channel $arg(glob)]
} dump {
set fd [open $arg(file) "w+"]
puts $fd [list channel create $arg(name) \
[list $_channel($arg(name))]]
close $fd
}
}
return
}
# The command created by channel
proc _channel_cmd {name args} {
global _channel
set syntax {
add {{+ name}}
remove {{+ name}}
names {}
msg {{+ msg}}
}
switch -exact [check -opts $name $syntax $args] {
add {
lappend _channel($name) $arg(name)
} remove {
set i [lsearch -exact $_channel($name) $arg(name)]
if {$i != -1} {
set _channel($name) [lreplace $_channel($name) $i $i]
}
} names {
return $_channel($name)
} msg {
foreach member $_channel($name) {
write "tell $member \[$name\]: $arg(msg)"
}
}
}
return
}
|
