chiark / gitweb /
untell works for unregistered nicks
[ircbot] / parsecmd.tcl
... / ...
CommitLineData
1proc ta_anymore {} {
2 upvar 1 text text
3 return [expr {!![string length $text]}]
4}
5
6proc ta_nomore {} {
7 upvar 1 text text
8 if {[string length $text]} { error "too many parameters" }
9}
10
11proc ta_word {} {
12 upvar 1 text text
13 if {![regexp {^([^ ]+) *(.*)} $text dummy firstword text]} {
14 error "too few parameters"
15 }
16 return $firstword
17}
18
19proc ta_nick {} {
20 upvar 1 text text
21 set v [ta_word]
22 check_nick $v
23 return $v
24}
25
26proc ta_interval_optional {min def} {
27 upvar 1 text text
28 if {[ta_anymore]} {
29 return [parse_interval [ta_word] $min]
30 } else {
31 return $def
32 }
33}
34
35proc usererror {emsg} { error $emsg {} {BLIGHT USER} }
36
37proc go_usercommand {p c n dest text} {
38 regsub {^! *} $text {} text
39 set ucmd [ta_word]
40 set procname ucmd/[string tolower $ucmd]
41 if {[catch { info body $procname }]} {
42 usererror "Unknown command; try help for Help."
43 }
44 $procname $p $dest
45}
46
47proc execute_usercommand {p c n output dest text} {
48 global errorCode
49 if {[catch {
50 go_usercommand $p $c $n $dest $text
51 } rv]} {
52 if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
53 sendprivmsg $n $rv
54 } else {
55 manyset $rv priv_msgs pub_msgs priv_acts pub_acts
56 foreach {td val} [list $n $priv_acts $output $pub_acts] {
57 foreach l [split $val "\n"] {
58 sendaction_priority 0 $td $l
59 }
60 }
61 foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
62 foreach l [split $val "\n"] {
63 sendprivmsg $td $l
64 }
65 }
66 }
67}
68
69proc def_ucmd {cmdname body} {
70 proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body"
71}
72
73proc def_ucmd_alias {alias canon} {
74 proc ucmd/$alias {p dest} " uplevel 1 \[list ucmd/$canon \$p \$dest\]\n"
75}
76
77proc ucmdr {priv pub args} {
78 return -code return [concat [list $priv $pub] $args]
79}
80
81proc new_event {} {
82 global errorInfo errorCode
83 set ei $errorInfo
84 set ec $errorCode
85 catch { unset calling_nick }
86 set errorInfo $ei
87 set errorCode $ec
88}