@q
@program cmd-@pemit
1 99999 d
i
( cmd-@pemit   v1.0    Jessy @ FurryMUCK    12/99
  
  This is an emulated version of the MUSH/MUX @pemit command.
  
  INSTALLATION:
  
  Create a global action with the following name:
  
    @pemit;@pemit/contents;@pemit/object;@pemit/noisy;@pemit/list
  
  Link the action to this program.
  
  USAGE: 
   
  Command: @pemit[/switches] <what> = <message>
  Emits <message> only to <what>, or to <what>'s contents if the /contents
  switch is given. <what> must be either in the same location as you or be
  something you control.
 
  The following switches are available:
    /contents - Send the message to the contents of the named object.
    /object   - Send the message to the named object.
    /noisy    - Send to the enactor of the command what was pemitted.
    /list     - Send the message to the given list of players.
 
  You may combine switches.
 
  Compatibility Notes: The /list switch is not really applicable on 
  MUCK: it may be included, but makes no functional difference to the 
  command's behavior. That is, <what> is always treated as a space-
  separated list. @dolist-type substitutions are not supported. If 
  multiple switches are used, a space must follow the command name and 
  precede the first switch. For example, 
   
    @pemit /contents/noisy <what> = <msg>
    
  would work, but...    
  
    @pemit/contents/noisy <what> = <msg>
  
  would not.
  
  cmd-@pemit may be freely ported. Please comment any changes.
)
  
$define Tell me @ swap notify $enddef
 
lvar ourArg 
lvar ourCom
lvar ourContents
lvar ourObject
lvar ourNoisy
lvar ourList
lvar ourBoolean
 
: DoHelp  (  --  )                                (* show help screen *)
  
  "This is an emulated version of the MUSH/MUX @pemit command." 
  Tell " " Tell 
   
  "Command: $command[/switches] <what> = <message>" 
  ourCom @ "$command" subst Tell
  
  "Emits <message> only to <what>, or to <what>'s contents if the "
  "/contents switch is given. <what> must be either in the same location "
  "as you or be something you control."
  strcat strcat Tell " " Tell
 
  "  /list     - Send the message to the given list of players."
  "  /noisy    - Send to the enactor of the command what was pemitted."
  "  /object   - Send the message to the named object."
  "  /contents - Send the message to the contents of the named object."
  "The following switches are available:"
  Tell Tell Tell Tell Tell " " Tell
  
  "You may combine switches." Tell " " Tell
  
  "Compatibility Notes: The /list switch is not really applicable on "
  "MUCK: it may be included, but makes no functional difference to the "
  "command's behavior (that is, <what> is always treated as a space-sep"
  "arated list). @dolist-type substitutions are not supported. If "
  "multiple switches are used, a space must follow the command name and "
  "precede the first switch (ex: '$command /contents/noisy <what> = <msg>'"
  "will work, but '$command/contents/noisy <what> = <msg>' will not)."
  strcat strcat strcat strcat strcat strcat 
  ourCom @ "$command" subst Tell
;
 
: DoShowSyntax  (  --  )                       (* show command syntax *)
  
  "$command[/switches] <what> = <message>"
  ourCom @ "$command" subst Tell
;
 
: DoOurMatch  ( s -- d )                           (* match cmd arg s *)
  
  match 
  dup #-1 dbcmp if
    "I don't see that here." Tell 
  then
  dup #-2 dbcmp if
    "I don't know which one you mean!" Tell
    pop #-1
  then
  dup if
    dup location me @ location dbcmp not if
      me @ over controls not if
        "Permission denied." Tell pop #-1
      then
    then
  then
;
 
: DoPemit  ( d --  )            (* emit ourArg to specified player[s] *)
  
  dup if
    dup dbref? if
      dup ok? if
        ourArg @ notify
        ourNoisy @ ourBoolean @ not and if
          me @ "You pemited '$arg'" ourArg @ "$arg" subst notify
          1 ourBoolean !
        then
      then
    then
  else
    pop
  then
;
 
: DoPreEmit  ( s --  )  
                   (* do all matching and perm checking for cmd arg s *)
  
  ourContents @ if
    DoOurMatch dup if
      me @ over controls not if
        "Permission denied." Tell pop exit
      then
      contents
      begin
        dup while
        dup DoPemit
        next
      repeat
      pop
      ourNoisy @ ourBoolean @ not and if
        me @ "You pemited '$arg'" ourArg @ "$arg" subst notify
      then
    else
      "I don't see that here." Tell pop
    then
  else
    DoOurMatch
    DoPemit
  then
;
 
: DoParse
  
  command @ "/contents" instr if 1 ourContents ! then
  command @ "/object"   instr if 1 ourObject   ! then
  command @ "/noisy"    instr if 1 ourNoisy    ! then
  command @ "/list"     instr if 1 ourList     ! then
  
  ourArg @ "=" instr dup if
    ourArg @ swap strcut strip ourArg !
    strip dup strlen 1 - strcut pop strip
    dup "/contents" instr if
      1 ourContents !
      "" "/contents" subst
    then
    dup "/object" instr if
      1 ourObject !
      "" "/object" subst
    then
    dup "/noisy" instr if
      1 ourNoisy !
      "" "/noisy" subst
    then
    dup "/list" instr if
      1 ourList !
      "" "/list" subst
    then
    strip
    " " explode
    begin
      dup while
      swap DoPreEmit
      1 -
    repeat
    pop
  else
    DoShowSyntax pop
  then
;
 
: main
  
  "me" match me !
  ourArg !
  trig name dup ";" instr dup if
    1 - strcut pop ourCom ! 
  else
    pop pop command @ ourCom !
  then
  
  ourArg @ if
    "#help"   ourArg @ stringpfx if DoHelp exit else
    ourArg @ pop
    then
  then
  
  DoParse
;
.
c
q