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 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 }