| 1 | proc ta_anymore {} { |
| 2 | upvar 1 text text |
| 3 | return [expr {!![string length $text]}] |
| 4 | } |
| 5 | |
| 6 | proc ta_nomore {} { |
| 7 | upvar 1 text text |
| 8 | if {[string length $text]} { error "too many parameters" } |
| 9 | } |
| 10 | |
| 11 | proc 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 | |
| 19 | proc ta_nick {} { |
| 20 | upvar 1 text text |
| 21 | set v [ta_word] |
| 22 | check_nick $v |
| 23 | return $v |
| 24 | } |
| 25 | |
| 26 | proc 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 | |
| 35 | proc usererror {emsg} { error $emsg {} {BLIGHT USER} } |
| 36 | |
| 37 | proc 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 | |
| 47 | proc 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 | |
| 69 | proc def_ucmd {cmdname body} { |
| 70 | proc ucmd/$cmdname {p dest} " upvar 1 text text\n$body" |
| 71 | } |
| 72 | |
| 73 | proc def_ucmd_alias {alias canon} { |
| 74 | proc ucmd/$alias {p dest} " uplevel 1 \[list ucmd/$canon \$p \$dest\]\n" |
| 75 | } |
| 76 | |
| 77 | proc ucmdr {priv pub args} { |
| 78 | return -code return [concat [list $priv $pub] $args] |
| 79 | } |
| 80 | |
| 81 | proc 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 | } |