@q
@program cmd-@adisconnect
1 99999 d
i
( cmd-@adisconnect   v1.1   Jessy @ FurryMUCK   11/99, 1/00
  
  This is an emulated version of the MUSH/MUX @adisconnect command.
  
  INSTALLATION:
   
  Create a global action and link it to this program. Set the program 
  Wizard and Link_OK.
  
  USAGE:
  
    @adisconnect <object> = <command-list>
    
  The only meaningful entries for <object> are 'me' and #0.
  
  <command-list> is a semi-colon-separated list of commands to be run
  at disconnection time.
  
  cmd-@adisconnect may be freely ported. Please comment any changes.
)
  
$define Tell me @ swap notify $enddef
  
lvar ourObject
lvar ourString
  
: DoHelp  ( s --  )                               (* show help screen *)
  
  pop
  "This is an emulated version of the MUSH/MUX @adisconnect command."
  Tell " " Tell
  
  "Command: @adisconnect <object> = <command-list> Tell
  "Property: _prefs/adisconnect" Tell " " Tell
 
  "Sets the actions to be taken by a player right after disconnecting to "
  "the game. If <object> is a player, actions run each time that player "
  "disconnects. If <object> is Room #0, actions run each time any player "
  "disconnects. Only wizards may set global adisconnects."
  strcat strcat strcat Tell " " Tell
 
  "Example: @adisconnect me = gohome;wear main" Tell " " Tell
 
  "See also: @aconnect." Tell
;
  
: DoSetAdisconnect  ( s --  )               (* set disconnection actions *)
  
  dup "=" instr if                                           (* parse *)
    dup "=" instr strcut
    strip ourString !
    strip dup strlen 1 - strcut pop strip ourObject !
  else
    ourObject !
  then
  
  ourObject @ match                                          (* match *)
  dup not if
    "I don't see that here." Tell exit
  then
  dup #-2 dbcmp if
    "I don't know which one you mean!" Tell exit
  then
  ourObject !
  
  me @ ourObject @ controls not if                (* check permission *)
    "Permission denied." Tell exit
  then
  
  ourObject @ player? not if              (* bail for invalid objects *)
    ourObject @ #0 dbcmp not if
      "Set." Tell exit
    then
  then
  
  ourObject @ "_prefs/adisconnect" getpropstr if
    ourObject @ "_disconnect/zadisconnect" prog setprop
  else
    ourObject @ "_disconnect/zadisconnect" remove_prop
  then
  
  ourObject @ "_prefs/adisconnect" ourString @ setprop         (* set *)
  "Set." Tell
;
 
: DoAdisconnects  (  --  )               (* run disconnection actions *)
  
                                            (* first personal ones... *)
  me @ "_prefs/adisconnect" getpropstr dup if
    ";" explode
    begin
      dup while
      me @ rot force
      1 -
    repeat
    pop
  else
    pop
  then
                                              (* ... then the globals *)
  #0 "_prefs/adisconnect" getpropstr dup if
    ";" explode
    begin
      dup while
      me @ rot force
      1 -
    repeat
    pop
  else
    pop
  then
;
  
: main
  
  "me" match me !
  trig if
    dup if
      "#help" over stringpfx if
        DoHelp
      else
        DoSetAdisconnect
      then
    else
      "I don't see that here." Tell
    then
  else
    DoAdisconnects
  then
;
.
c
q