chiark - git - mdw - ircbot/blob - parsecmd.tcl

   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 usererror {emsg} { error $emsg {} {BLIGHT USER} }
  27
  28 proc go_usercommand {p c n dest text} {
  29     regsub {^! *} $text {} text
  30     set ucmd [ta_word]
  31     set procname ucmd/[string tolower $ucmd]
  32     if {[catch { info body $procname }]} {
  33         usererror "Unknown command; try help for help."
  34     }
  35     $procname $p $dest
  36 }
  37
  38 proc execute_usercommand {p c n output dest text} {
  39     global errorCode
  40     if {[catch {
  41         go_usercommand $p $c $n $dest $text
  42     } rv]} {
  43         if {"$errorCode" != "BLIGHT USER"} { set rv "error: $rv" }
  44         sendprivmsg $n $rv
  45     } else {
  46         manyset $rv priv_msgs pub_msgs priv_acts pub_acts
  47         foreach {td val} [list $n $priv_acts $output $pub_acts] {
  48             foreach l [split $val "\n"] {
  49                 sendaction_priority 0 $td $l
  50             }
  51         }
  52         foreach {td val} [list $n $priv_msgs $output $pub_msgs] {
  53             foreach l [split $val "\n"] {
  54                 sendprivmsg $td $l
  55             }
  56         }
  57     }
  58 }
  59
  60 proc def_ucmd {cmdname body} {
  61     proc ucmd/$cmdname {p dest} "    upvar 1 text text\n$body"
  62 }
  63
  64 proc ucmdr {priv pub args} {
  65     return -code return [concat [list $priv $pub] $args]
  66 }
  67
  68 proc new_event {} {
  69     global errorInfo errorCode
  70     set ei $errorInfo
  71     set ec $errorCode
  72     catch { unset calling_nick }
  73     set errorInfo $ei
  74     set errorCode $ec
  75 }