Experimental Guinea Pig Class with Even More Features of Dubious Utility #5803

@ss*how

Spec any any anyFlags rdOwner #6349Definer #5803

Referenced by

none

Source

"A short version of @show that doesn't list properties or verbs.";
set_task_perms(player);
if ((player != this) || (dobjstr == ""))
  player:notify(tostr("Usage:  ", verb, " <object-or-property-or-verb>"));
  return;
endif
if (index(dobjstr, ".") && (spec = $code_utils:parse_propref(dobjstr)))
  if (valid(object = player.location:match_object(spec[1])))
    return $code_utils:show_property(object, spec[2]);
  endif
elseif (spec = $code_utils:parse_verbref(dobjstr))
  if (valid(object = player.location:match_object(spec[1])))
    return $code_utils:show_verbdef(object, spec[2]);
  endif
elseif (((dobjstr[1] == "$") && ((pname = dobjstr[2..length(dobjstr)]) in properties(#0))) && (typeof(#0.(pname)) == OBJ))
  if (valid(object = #0.(pname)))
    return $code_utils:show_object(object, {});
  endif
elseif ((dobjstr[1] == "$") && (spec = $code_utils:parse_propref(dobjstr)))
  return $code_utils:show_property(#0, spec[2]);
else
  if (valid(object = player.location:match_object(dobjstr)))
    return $code_utils:show_object(object, {});
  endif
endif
if (object == $failed_match)
  player:notify(tostr("I see no \"", dobjstr, "\" here."));
elseif (object == $ambiguous_match)
  player:notify(tostr("I don't know which \"", dobjstr, "\" you mean."));
else
  player:notify(tostr(object, " does not exist."));
endif

ways

Spec none any anyDefiner #5803

Referenced by

none

Source

"This command lists all of the obvious exits from the current location.  It takes no arguments.";
exits = {};
if (#0 == (where = (iobjstr && (iobjstr != "here")) ? toobj(iobjstr) | player.location))
  player:tell("No such place:  ", iobjstr);
  return;
elseif (!(valid(where) && ($room in $object_utils:ancestors(where))))
  player:tell((where == player.location) ? "You are not in a room." | "That is not actually a room.");
  return;
endif
for e in (this:obvious_exits())
  if (valid(eo = where:match_exit(e)))
    exits = setadd(exits, eo);
  endif
endfor
enames = {};
for e in (exits)
  en = e.aliases[1];
  for a in (listdelete(e.aliases, 1))
    en = (en + ",") + a;
  endfor
  enames = {@enames, ("(" + en) + ")"};
endfor
player:tell($string_utils:english_list(enames, "none"), ".");

!*

Spec any any anyFlags rDefiner #5803

Referenced by

none

Source

"This is the polite spoof verb.  `!<string>'  announces an arbitrary string to the current location, except that if the string doesn't contain the player name somewhere as a distinct word, the player's .spoof_attribution property (with the substitutions of player.name for %n and % for %%) is appended and if the resulting strings *still* doesn't contain player.name, we append it.";
if (player != this)
  player:tell(("Sorry, you can't use " + this.name) + "'s ! verb");
  return;
endif
argstr = $code_utils:argstr(verb, args);
if (length(verb) > 1)
  msg = (verb[2..length(verb)] + " ") + argstr;
else
  msg = argstr;
endif
if (!$string_utils:index_delimited(msg, player.name))
  attrib = player.spoof_attribution;
  msg = msg + $string_utils:subst(attrib, {{"%n", player.name}, {"%%", "%"}});
  if (!$string_utils:index_delimited(msg, player.name))
    msg = msg + player.name;
  endif
endif
player.location:announce_all(msg);

@lastlog

Spec any any anyFlags rxdDefiner #5803

Referenced by

none

Source

"Syntax:  @lastlog [from [#] (day|week|month)[s]]";
"         @lastlog <player> [<player>...]";
"";
"The first form prints the last login times for all players that logged in within the indicated period.  Default period is the past week.  The second form is now synonymous with @who.";
if (caller != player)
  return E_PERM;
endif
a_day = (24 * 60) * 60;
a_week = 7 * a_day;
a_month = 30 * a_day;
if (dobjstr == "")
  folks = players();
  from = a_week;
else
  this:("@who")(@$string_utils:words(dobjstr));
  return;
endif
if (prepstr != "")
  n = 1;
  if ((((prepstr != "from") || (!(w = $string_utils:explode(iobjstr)))) || ((length(w) > 1) && (!(n = tonum(w[1]))))) || (!(u = (wd = w[length(w)])[1..(wd[len = length(wd)] == "s") ? len - 1 | len] in {"day", "week", "month"})))
    player:tell("Usage:  ", verb, " [<players>] [from [#] (day|week|month)[s]]");
    return;
  endif
  from = n * {a_day, a_week, a_month}[u];
endif
day = week = month = ever = never = {};
now = time();
for x in (folks)
  when = x.last_connect_time;
  how_long = now - when;
  if (from && (how_long > from))
  elseif (when == 0)
    never = {@never, x};
  elseif (how_long < a_day)
    day = {@day, x};
  elseif (how_long < a_week)
    week = {@week, x};
  elseif (how_long < a_month)
    month = {@month, x};
  else
    ever = {@ever, x};
  endif
endfor
for entry in ({{day, "the last day"}, {week, "the last week"}, {month, "the last 30 days"}, {ever, "recorded history"}})
  if (entry[1])
    player:tell("Players who have connected within ", entry[2], ":");
    for x in (entry[1])
      player:tell("  ", x.name, " last connected ", ctime(x.last_connect_time), ".");
    endfor
  endif
endfor
if (never)
  player:tell("Players who have not connected since connect-time accounting was established:");
  player:tell("  ", $string_utils:english_list($list_utils:map_prop(never, "name")));
endif

boring

Spec any any anyFlags rdOwner #68Definer #5803

Referenced by

none

Source

"\"boring on\" makes you immune to food fights.  \"boring off\" allows you to participate again.";
if (argstr in {"on", "yes"})
  this.boring = 1;
  player:tell("You are now boring.");
elseif (argstr in {"off", "no"})
  this.boring = 0;
  player:tell("You have become more interesting.");
elseif (!argstr)
  this.boring = !this.boring;
  player:tell("Toggled boring state: status now ", this.boring ? "boring." | "interesting.");
else
  player:tell("Say what?  Yes or No, On or Off.");
  return;
endif
this.boring ? player:announce($string_utils:pronoun_sub("%N forms a transparent shield around %r, impervious to food.")) | player:announce(player.name, "'s transparent shield evaporates.");

acceptable

Spec this none thisFlags rxdOwner #68Definer #5803

Referenced by

• #2693:acceptable line 1: pass(

Source

return pass(@args) && (this.boring ? !(#3452 in $object_utils:ancestors(args[1])) | 1);

description

Spec this none thisFlags rxdOwner #68Definer #5803

Referenced by

• #2693:description line 2: pass(
• #2693:description line 4: pass(

Source

base = pass(@args);
boring = this.boring && $string_Utils:pronoun_sub("%S %<seems> to have a transparent shield surrounding %o, rendering %o impervious to food fights.", this);
if (typeof(base) == STR)
  return boring ? tostr(base, "  ", boring) | base;
elseif (typeof(base) == LIST)
  return {@base, @boring ? {boring} | {}};
endif

old#

Spec any none noneFlags rOwner #6349Definer #5803

Referenced by

none

Source

"#string [exit|player|inventory] returns the object id corresponding to the object named by string.  String is matched in the current room unless one of exit|player|inventory is given.";
set_task_perms(player);
if (!(whatstr = verb[2..dot = min(index(verb + ".", "."), index(verb + ":", ":")) - 1]))
  player:tell("Usage:  #string [exit|player|inventory]");
  return;
elseif (!args)
  what = player:my_match_object(whatstr);
elseif (index("exits", args[1]) == 1)
  what = player.location:match_exit(whatstr);
elseif (index("inventory", args[1]) == 1)
  what = player:match(whatstr);
elseif (index("players", args[1]) == 1)
  what = $string_utils:match_player(whatstr);
  if ($command_utils:player_match_result(what, whatstr)[1])
    return;
  endif
else
  player:tell(args[1], "?  arg should be one of exits,inventory,players");
  return;
endif
if ((!valid(what)) && $match(whatstr, "^[0-9]+$"))
  what = toobj(whatstr);
endif
if ($command_utils:object_match_failed(what, whatstr))
  return;
endif
while (index(verb, ".parent") == (dot + 1))
  what = parent(what);
  dot = dot + 7;
endwhile
if (dot >= length(verb))
  player:tell("=> ", what, "  (", what.name, ")");
elseif (!(value = $code_utils:eval_d(tostr("return ", what, verb[dot + 1..length(verb)], ";")))[1])
  player:tell_lines(value[2]);
elseif (typeof(val = value[2]) == OBJ)
  player:tell("=> ", val, "   ", ((val < #0) && (val >= #-3)) ? $list_utils:assoc(val, {{$nothing, "<$nothing>"}, {$ambiguous_match, "<$ambiguous_match>"}, {$failed_match, "<$failed_match>"}})[2] | (valid(val) ? ("(" + val.name) + ")" | "<invalid>"));
elseif (typeof(val) == ERR)
  player:tell("=> ", $code_utils:error_name(val), "   [", val, "]");
else
  player:tell("=> ", $string_utils:print(value[2]));
endif

party

Spec none none noneDefiner #5803

Referenced by

none

Source

"where's the party?";
"doesn't query about a room if you're already there.";
"checks for custom :accept and :is_unlocked_for on the room and, if not present, tries calling :accept before giving the query.";
rooms = {};
for p in (connected_players())
  if ($object_utils:connected(p))
    if ((valid(loc = p.location) && $object_utils:isa(loc, $generic_editor)) && (l = p in loc.active))
      loc = loc.original[l];
      $command_utils:suspend_if_needed(0, "... generating party listing ...");
    endif
    if (i = $list_utils:iassoc_suspended(loc, rooms))
      rooms[i] = {loc, rooms[i][2] - 1, {@rooms[i][3], p}, min(rooms[i][4], idle_seconds(p))};
    else
      rooms = {@rooms, {loc, -1, {p}, idle_seconds(p)}};
    endif
  endif
endfor
rooms = $list_utils:sort_suspended(0, rooms, $list_utils:slice(rooms, 4));
rooms = $list_utils:sort_suspended(0, rooms, $list_utils:slice(rooms, 2));
for r in (rooms)
  if (r[2] < -1)
    player:tell(r[1].name, "(", r[1], ") --- ", $string_utils:from_seconds(r[4]), " idle, ", -r[2], " players:");
    l = tostr("     ", r[3][1].name, "(", r[3][1], ")");
    for p in (listdelete(r[3], 1))
      s = tostr(p.name, "(", p, ")");
      if ((length(s) + length(l)) > 72)
        player:tell(l, ",");
        l = "     ";
      else
        l = tostr(l, ", ");
      endif
      l = l + s;
    endfor
    player:tell(l);
    if (player.location == r[1])
      player:tell("You are already in this location.");
    elseif (((a = $object_utils:has_verb(r[1], "accept")) && (a[1] != $room)) || ((u = $object_utils:has_verb(r[1], "is_unlocked_for")) && (u[1] != $root_class)))
      player:tell("This room may have funky security apparatus.");
      if ($command_utils:yes_or_no("Go there?"))
        player:teleport(player, r[1]);
        return;
      endif
    elseif (!r[1]:accept(player))
      player:tell("That location will not let you in.");
    elseif ($command_utils:yes_or_no("Go there?"))
      player:teleport(player, r[1]);
      return;
    endif
  endif
endfor
player:tell("No more parties.");

@dump(old)

Spec any any anyFlags rOwner #6349Definer #5803

Referenced by

none

Source

"@dump something [with [id=...] [noprops] [noverbs] [create]]";
"This spills out all properties and verbs on an object, calling suspend at appropriate intervals.";
"   id=#nnn -- specifies an idnumber to use in place of the object's actual id (for porting to another MOO)";
"   noprops -- don't show properties.";
"   noverbs -- don't show verbs.";
"   create  -- indicates that a @create command should be generated and all of the verbs be introduced with @verb rather than @args; the default assumption is that the object already exists and you're just doing this to have a look at it.";
set_task_perms(player);
dobj = player:my_match_object(dobjstr);
if ($command_utils:object_match_failed(dobj, dobjstr))
  return;
endif
if (prepstr && (prepstr != "with"))
  player:notify(tostr("Usage:  ", verb, " something [with [id=...] [noprops] [noverbs] [create]]"));
  return;
endif
targname = tostr(dobj);
options = {"props", "verbs"};
create = 0;
if (iobjstr)
  for o in ($string_utils:explode(iobjstr))
    if (index(o, "id=") == 1)
      targname = o[4..length(o)];
    elseif (o in {"noprops", "noverbs"})
      options = setremove(options, o[3..length(o)]);
    elseif (o in {"create"})
      create = 1;
    endif
  endfor
endif
if (create)
  parent = parent(dobj);
  pstring = tostr(parent);
  for p in (properties(#0))
    if (#0.(p) == parent)
      pstring = "$" + p;
    endif
  endfor
  player:notify(tostr("@create ", pstring, " named ", dobj.name, ":", $string_utils:from_list(dobj.aliases, ",")));
endif
for p in (("props" in options) ? properties(dobj) | {})
  pquoted = $string_utils:print(p);
  info = property_info(dobj, p);
  value = dobj.(p);
  if (create)
    uvalue = (typeof(value) == LIST) ? "{}" | 0;
    player:notify(tostr("@prop ", targname, ".", pquoted, " ", uvalue || $string_utils:print_suspended(value), " ", info[2] || "\"\"", (info[1] == dobj.owner) ? "" | tostr(" ", info[1])));
    if (uvalue && value)
      player:notify(tostr(";", targname, ".(", pquoted, ") = ", $string_utils:print_suspended(value)));
    endif
  else
    if (info[2] != "rc")
      player:notify(tostr("@chmod ", targname, ".", pquoted, " ", info[2]));
    endif
    if (info[1] != dobj.owner)
      player:notify(tostr("@chown ", targname, ".", pquoted, " ", info[1]));
    endif
    player:notify(tostr(";", targname, ".(", pquoted, ") = ", $string_utils:print_suspended(value)));
  endif
  $command_utils:suspend_if_needed(0);
endfor
for a in (("props" in options) ? $object_utils:ancestors(dobj) | {})
  for p in (properties(a))
    $command_utils:suspend_if_needed(1);
    pquoted = $string_utils:print(p);
    value = dobj.(p);
    avalue = a.(p);
    if (typeof(value) == ERR)
      player:notify(tostr("\"", targname, ".(", pquoted, ") => ", $code_utils:error_name(value), " (", value, ")"));
    elseif ((typeof(avalue) == ERR) || (value != avalue))
      player:notify(tostr(";", targname, ".(", pquoted, ") = ", $string_utils:print_suspended(value)));
    endif
  endfor
  $command_utils:suspend_if_needed(1);
endfor
if (!("verbs" in options))
  return;
endif
player:notify("");
v = tostr(0);
while ((info = verb_info(dobj, v)) || (info == E_PERM))
  if (index(info[3], "("))
    player:tell("Skipping ", dobj, ":\"", v, "\"...");
  else
    suspend(1);
    if (typeof(info) == ERR)
      player:notify(tostr("\"", dobj, ":", v, " --- ", info, "\";"));
    else
      if (i = index(vname = info[3], " "))
        vname = vname[1..i - 1];
      endif
      if (vname[1] != "*")
        vname = strsub(vname, "*", "");
      endif
      args = verb_args(dobj, v);
      prep = (args[2] in {"any", "none"}) ? args[2] | $code_utils:short_prep(args[2]);
      perms = (info[2] != ((args == {"this", "none", "this"}) ? "rxd" | "rd")) ? info[2] || "\"\"" | "";
      if (create)
        if (info[1] == dobj.owner)
          tail = perms ? tostr(" ", perms) | "";
        else
          tail = tostr(" ", perms || info[2], " ", info[1]);
        endif
        player:notify(tostr("@verb ", targname, ":\"", info[3], "\" ", args[1], " ", prep, " ", args[3], tail));
      else
        player:notify(tostr("@args ", targname, ":\"", info[3], "\" ", args[1], " ", prep, " ", args[3]));
        if (info[1] != dobj.owner)
          player:notify(tostr("@chown ", targname, ":", vname, " ", info[1]));
        endif
        if (perms)
          player:notify(tostr("@chmod ", targname, ":", vname, " ", perms));
        endif
      endif
      if (code = verb_code(dobj, v, 1, 1))
        player:notify(tostr("@program ", targname, ":", vname));
        for c in (code)
          player:notify(c);
          $command_utils:suspend_if_needed(0);
        endfor
        player:notify_lines({".", ""});
      endif
    endif
  endif
  if (index(tostr(" ", info[3], " "), " * "))
    "... oh shit, we have a * verb.  may as well forget trying to list...";
    "... the rest; they're invisible.  set v to something nonstring.";
    v = E_TYPE;
  else
    v = tostr(tonum(v) + 1);
  endif
  $command_utils:suspend_if_needed(0);
endwhile

heartbeat

Spec this none thisFlags rxdOwner #6349Definer #5803

Referenced by

• #5803:heartbeat line 10: this:heartbeat

Source

":heartbeat([n]) -- starts up a task to print out the time every n minutes from now on unless you've been active during that minute.  Good for people who like to stay idle for long periods of time and who want to have some means of dating occurences that show up at random in their EMACS buffers...";
set_task_perms(this);
if ((((caller != this) && (caller_perms() != this)) && (!caller_perms().wizard)) || (!(this in connected_players())))
  return;
elseif ((idle_seconds(this) > 60) && (output_delimiters(this) == {"", ""}))
  notify(this, tostr(" - - - ", this:ctime()[12..16], " - - -"));
endif
n = args ? tonum(args[1]) | 1;
fork ((60 * n) - (time() % (60 * n)))
  this:heartbeat(n);
endfork

@edit(old)

Spec any any anyDefiner #5803

Referenced by

none

Source

"a slightly more intelligent @edit.";
"Calls the verb editor on verbs, the note editor on properties, and on anything else assumes it's an object for which you want to edit the .description.";
if ((!args) || $code_utils:parse_verbref(args[1]))
  $verb_editor:invoke(argstr, verb);
elseif ($code_utils:parse_propref(dobjstr))
  $note_editor:invoke(dobjstr, verb);
elseif (dobjstr)
  $note_editor:invoke(dobjstr + ".description", verb);
else
  ((player in $note_editor.active) ? $note_editor | $verb_editor):invoke(dobjstr, verb);
endif

all_connect_places

Spec this none thisFlags rxdOwner #24442Definer #5803

Referenced by

none

Source

if (!$perm_utils:controls(caller_perms(), this))
  return E_PERM;
endif
return this.all_connect_places;

linesplit(old)

Spec this none thisFlags rxdOwner #6349Definer #5803

Referenced by

none

Source

":linesplit(line,len) => list of substrings of line";
"used by :notify to split up long lines if .linelen>0";
line = args[1];
len = args[2];
cline = {};
while (length(line) > len)
  cutoff = rindex(line[1..len], " ");
  if (nospace = cutoff < ((4 * len) / 5))
    cutoff = len + 1;
    nospace = line[cutoff] != " ";
  endif
  cline = {@cline, line[1..cutoff - 1]};
  line = (nospace ? " " | "") + line[cutoff..length(line)];
endwhile
return {@cline, line};

notify(old)

Spec this none thisFlags rxdOwner #6349Definer #5803

Referenced by

none

Source

set_task_perms(caller_perms());
line = args[1];
if (this.pagelen && (this in connected_players()))
  if ((player == this) && (this.linetask[2] != task_id()))
    "...player has started a new task...";
    "....linetask[2] is the taskid of the most recent player task...";
    if (this.linetask[2] != this.linetask[1])
      this.linesleft = this.pagelen - 2;
    endif
    this.linetask[2] = task_id();
  endif
  "... digest the current line...";
  if (this.linelen)
    lbuf = {@this.linebuffer, @this:linesplit(line, this.linelen)};
  else
    lbuf = {@this.linebuffer, line};
  endif
  llen = length(lbuf);
  "... print out what we can...";
  if (this.linesleft)
    howmany = min(this.linesleft, llen);
    for l in (lbuf[1..howmany])
      notify(this, l);
    endfor
    this.linesleft = this.linesleft - howmany;
    lbuf = lbuf[howmany + 1..llen];
    llen = llen - howmany;
  endif
  if (llen)
    "...see if we need to say ***More***";
    if (this.linetask[1] != this.linetask[2])
      "....linetask[1] is the taskid of the most recent player task";
      "...   for which ***More*** was printed...";
      this.linetask[1] = this.linetask[2];
      fork (0)
        notify(this, strsub(this.more_msg, "%n", tostr(length(this.linebuffer))));
      endfork
    endif
    if (llen > 500)
      "...way too much saved text, flush some of it...";
      lbuf = {"*** buffer overflow, lines flushed ***", @lbuf[llen - 99..llen]};
    endif
  endif
  this.linebuffer = lbuf;
elseif (this.linelen)
  for l in (this:linesplit(line, this.linelen))
    notify(this, l);
  endfor
else
  notify(this, line);
endif

@pagelength(old)

Spec any none noneFlags rOwner #6349Definer #5803

Referenced by

none

Source

set_task_perms(player);
"@pagelength number  -- sets page buffering to that many lines (or 0 to turn off page buffering)";
if (!dobjstr)
  notify(player, tostr("Usage:  ", verb, " <number>"));
  notify(player, tostr("Current page length is ", player.pagelen, "."));
  return;
elseif (0 > (newlen = tonum(dobjstr)))
  notify(player, "Page length can't be a negative number.");
  return;
elseif (newlen == 0)
  player.pagelen = 0;
  notify(player, "Page buffering off.");
elseif (newlen < 5)
  player.pagelen = 5;
  notify(player, "Too small.  Setting it to 5.");
else
  notify(player, tostr("Page length is now ", player.pagelen = newlen, "."));
endif
if (this.linebuffer)
  notify(this, strsub(this.more_msg, "%n", tostr(length(this.linebuffer))));
  player.linetask = {task_id(), task_id()};
  player.linesleft = 0;
else
  player.linetask = {0, task_id()};
  player.linesleft = player.pagelen - 2;
endif

@more(old)

Spec any none noneFlags rdOwner #6349Definer #5803

Referenced by

none

Source

set_task_perms(player);
if (!(lbuf = this.linebuffer))
  this.linesleft = this.pagelen - 2;
  notify(this, "*** No more ***");
elseif (index("flush", dobjstr || "x") == 1)
  this.linesleft = this.pagelen - 2;
  notify(this, tostr("*** Flushed ***  ", length(lbuf), " lines"));
  this.linebuffer = {};
elseif ((index("rest", dobjstr || "x") == 1) || (!this.pagelen))
  this.linesleft = this.pagelen - 2;
  for l in (lbuf)
    notify(this, l);
  endfor
  this.linebuffer = {};
else
  howmany = min(this.pagelen - 2, llen = length(lbuf = this.linebuffer));
  for l in (lbuf[1..howmany])
    notify(this, l);
  endfor
  this.linesleft = (this.pagelen - 2) - howmany;
  this.linebuffer = lbuf[howmany + 1..llen];
  if (howmany < llen)
    notify(this, strsub(this.more_msg, "%n", tostr(llen - howmany)));
    this.linetask[1] = task_id();
  endif
endif
this.linetask[2] = task_id();

+*

Spec any any anyFlags rxdOwner #3920Definer #5803

Referenced by

none

Source

"Copied from Rog (#4292):+ Tue Jun 28 16:19:42 1994 PDT";
"Copied from Puff (#1449):+ Sun Apr 25 11:31:11 1993 PDT";
"Copied from Experimental Guinea Pig Class with Even More Features of Dubious Utility (#5803):+ by Jonny (#3920) Fri Apr 23 20:04:14 1993 PDT";
"<Quinn's Page-Emote>";
"Usage: +<player> <emote>";
"   or: ++<player> <emote>  (possesive format)";
"";
"Example: +Voluptua licks hungrily at your inner thigh.";
"  Shows: (from Nut-Hut) Glub licks hungrily at your inner thigh.";
if ((!args) && (length(verb) < 3))
  player:tell("Usage: + <player> <emote> || ++ <player> <emote>");
  return;
endif
nargs = length(args);
vl = length(verb);
if ((verb == "+") || (verb == "++"))
  sf = args[1];
  ms_str = $string_utils:first_word(argstr)[2];
else
  sf = verb[rindex(verb, "+") + 1..vl];
  ms_str = argstr;
endif
who = $string_utils:match_player(sf);
if ($command_utils:player_match_result(who, sf)[1])
  return;
else
  "pr = this:ep_prefix_msg();";
  pr = $string_utils:pronoun_sub(this.remote_emote_prefix_msg);
  msg = tostr(player.name, (index(verb, "++") == 1) ? "" | " ", ms_str);
  result = who:receive_page(tostr(pr, " ", msg));
  if (result == 2)
    player:tell(who.name, " isn't connected.");
  elseif (result == 1)
    if (player:pc_option("remote_emote_noecho"))
      player:tell(who.name, " has received your emote.");
    else
      player:tell("(to ", who.name, ") ", msg);
    endif
  else
    player:tell(result);
    player:tell(who.name, " refused your emote.");
  endif
endif

eprint*

Spec any any anyFlags rdOwner #6349Definer #5803

Referenced by

none

Source

"eprint <expression>";
"eprint<n> <expression>";
"does a pretty-print trying to confine the result to n columns (n defaults to .linelen)";
set_task_perms(player);
e = #28888:eparse(argstr);
width = tonum(verb[7..length(verb)]) || ((player:linelen() || 79) - 5);
if (typeof(e) == STR)
  player:notify(tostr(e));
elseif (e[2] <= width)
  player:notify($string_utils:space(5) + #28888:print(e, ""));
else
  p = #28888:expand("", e, "", width, 0);
  player:notify_lines(#28888:indent(5, @p));
endif

@prettylist

Spec any none noneFlags rOwner #6349Definer #5803

Referenced by

none

Source

set_task_perms(player);
if (!(spec = $code_utils:parse_verbref(args[1])))
  player:tell("Usage:  ", verb, " <object>:<verb>");
  return;
endif
if ($command_utils:object_match_failed(object = player:my_match_object(spec[1]), spec[1]))
  return;
endif
what = object;
vname = spec[2];
while ((what != $nothing) && ((code = verb_code(what, vname, 1)) == E_VERBNF))
  what = parent(what);
endwhile
if (code == E_VERBNF)
  player:notify("That object does not define that verb.");
elseif (typeof(code) == ERR)
  player:notify(tostr(code));
elseif (code == {})
  player:notify("That verb has not been programmed.");
else
  if (what != object)
    player:notify(tostr("Object ", object, " does not define that verb, but its ancestor ", what, " does."));
  endif
  maxlen = (player:linelen() * 7) / 8;
  for line in (code)
    player:notify_lines(#28888:do_line(line, maxlen));
  endfor
  player:notify(".");
endif

@qsend(old)

Spec this none thisFlags rdDefiner #5803

Referenced by

none

Source

"Syntax: @quicksend player-or-mail-folder [subject=<text>] [<message>]";
"Sends player a quick message, without having to go to the mailroom.";
"If no message is given, prompt for lines of message.";
if (!args)
  player:tell("Usage:  @quicksend player-or-mail-folder message");
  return E_INVARG;
endif
recipient = $mail_agent:match_recipient(args[1]);
if (this != player)
  player:tell("You can't use ", this.pp, " @quicksend verb.");
  return E_PERM;
elseif ($mail_agent:match_failed(recipient, args[1]))
  return;
else
  if ((length(args) > 1) && ((eq = index(args[2], "=")) && (index("subject", args[2][1..eq - 1]) == 1)))
    subject = $string_utils:trim(args[2][eq + 1..length(args[2])]);
    ws = $string_utils:word_start(argstr);
    argstr = argstr[1..ws[1][2]] + argstr[ws[2][2] + 1..length(argstr)];
    args = listdelete(args, 2);
  else
    subject = "";
  endif
  if (length(args) > 1)
    message = argstr[index(argstr, " ") + 1..length(argstr)];
  else
    if (!(subject || player:mail_option("nosubject")))
      player:tell("Subject:");
      subject = $command_utils:read();
    endif
    player:tell("Enter lines of message:");
    message = $command_utils:read_lines();
    if (typeof(message) == ERR)
      player:tell(message);
      return;
    elseif (!(message || subject))
      player:tell("Won't send a blank message.");
      return;
    endif
  endif
  result = $mail_agent:send_message(this, recipient, subject, message);
  if (result && result[1])
    player:tell("@quicksend message sent to ", $mail_agent:name_list(@listdelete(result, 1)), ".");
  else
    player:tell("@quicksend not sent, for reasons the programmer doesn't fully comprehend.");
  endif
endif

@qreply(old)

Spec this none thisFlags rdDefiner #5803

Referenced by

none

Source

"@qreply <msg> [on *<recipient>] [<flags>...]";
"like @reply only, as in @qsend, we prompt for the message text using ";
"$command_utils:read_lines() rather than invoking the $mail_editor.";
set_task_perms(who = valid(caller_perms()) ? caller_perms() | player);
if (!(p = this:parse_mailread_cmd(verb, args, "", "on", 1)))
  "...garbled...";
elseif ($seq_utils:size(p[2]) != 1)
  player:notify("You can only answer *one* message at a time.");
elseif (LIST != typeof(flags_replytos = $mail_editor:check_answer_flags(@p[4])))
  player:notify_lines({tostr("Usage:  ", verb, " [message-# [on <recipient>]] [flags...]"), "where flags include any of:", "  all        reply to everyone", "  sender     reply to sender only", "  include    include the original message in your reply", "  noinclude  don't include the original in your reply"});
elseif ("include" in flags_replytos[1])
  player:notify("Can't include message on a @quickreply");
else
  this:set_current_folder(p[1]);
  if (to_subj = $mail_editor:parse_msg_headers(p[1]:messages_in_seq(p[2])[1][2], flags_replytos[1]))
    player:notify(tostr("To:       ", $mail_agent:name_list(@to_subj[1])));
    player:notify(tostr("Subject:  ", hdrs = to_subj[2]));
    if (replytos = flags_replytos[2])
      player:notify(tostr("Reply-to: ", $mail_agent:name_list(@replytos)));
      hdrs = {hdrs, replytos};
    endif
    player:notify("Enter lines of message:");
    message = $command_utils:read_lines();
    if (message)
      result = $mail_agent:send_message(this, to_subj[1], hdrs, message);
      if (result && result[1])
        player:notify(tostr("@quickreply message sent to ", $mail_agent:name_list(@listdelete(result, 1)), "."));
      else
        player:notify("@quickreply not sent.");
      endif
    elseif (typeof(message) == ERR)
      player:notify(tostr(message));
    else
      player:notify("Won't send blank message.");
    endif
  endif
endif

@nprop*erty

Spec any any anyFlags rOwner #6349Definer #5803

Referenced by

none

Source

set_task_perms(player);
nargs = length(args);
usage = tostr("Usage:  ", verb, " <object>.<prop-name> [<init_value> [<perms> [<owner>]]]");
if ((nargs < 1) || (!(spec = $code_utils:parse_propref(args[1]))))
  player:notify(usage);
  return;
endif
object = player:my_match_object(spec[1]);
name = spec[2];
if ($command_utils:object_match_failed(object, spec[1]))
  return;
endif
if (nargs < 2)
  value = 0;
else
  valstr = argstr[$string_utils:word_start(argstr)[2][1]..length(argstr)];
  if (!((e = $string_utils:end_expression(valstr)) && ((v = player:eval_cmd_string(valstr[1..e])) && v[1])))
    player:notify(tostr("Syntax error in initial value."));
    return;
  endif
  value = v[2];
  args = {args[1], value, @$string_utils:words(valstr[e + 1..length(valstr)])};
  nargs = length(args);
endif
perms = (nargs < 3) ? "rc" | args[3];
if (nargs < 4)
  owner = player;
else
  owner = $string_utils:match_player(args[4]);
  if ($command_utils:player_match_result(owner, args[4])[1])
    return;
  endif
endif
if (nargs > 4)
  player:notify(usage);
  return;
endif
e = $add_property(object, name, value, {owner, perms});
if (typeof(e) != ERR)
  player:notify(tostr("Property added with value ", $string_utils:print(object.(name), 1), "."));
elseif (e != E_INVARG)
  player:notify(tostr(e));
elseif ($object_utils:has_property(object, name))
  player:notify(tostr("Property ", object, ".", name, " already exists."));
else
  for i in [1..length(perms)]
    if (!index("rcw", perms[i]))
      player:notify(tostr("Unknown permission bit:  ", perms[i]));
      return;
    endif
  endfor
  "...the only other possibility...";
  player:notify("Property is already defined on one or more descendents.");
  player:notify(tostr("Try @check-prop ", args[1]));
endif

@nlist

Spec any any anyFlags rOwner #6349Definer #5803

Referenced by

none

Source

"@list <obj>:<verb> [<dobj> <prep> <iobj>] [with(out) parens|numbers] [ranges] [upload]";
set_task_perms(player);
pflag = player:prog_option("list_all_parens");
nflag = !player:prog_option("list_no_numbers");
upload = 0;
argspec = {};
range = {};
spec = args ? $code_utils:parse_verbref(args[1]) | E_INVARG;
args = spec ? listdelete(args, 1) | E_INVARG;
while (args)
  if (args[1] && ((index("without", args[1]) == 1) || (args[1] == "wo")))
    "...w,wi,wit,with => 1; wo,witho,withou,without => 0...";
    fval = !index(args[1], "o");
    if (index("parentheses", args[2]) == 1)
      pflag = fval;
      args = args[3..length(args)];
    elseif (index("numbers", args[2]) == 1)
      nflag = fval;
      args = args[3..length(args)];
    else
      player:notify(tostr(args[1], " WHAT?"));
      args = E_INVARG;
    endif
  elseif (index("0123456789", args[1][1]) || (index(args[1], "..") == 1))
    if (E_INVARG == (s = $seq_utils:from_string(args[1])))
      player:notify(tostr("Garbled range:  ", args[1]));
      args = E_INVARG;
    else
      range = $seq_utils:union(range, s);
      args = listdelete(args, 1);
    endif
  elseif (index("upload", args[1]) == 1)
    upload = 1;
    args = listdelete(args, 1);
  elseif (argspec)
    "... second argspec?  Not likely ...";
    player:notify(tostr(args[1], " unexpected."));
    args = E_INVARG;
  elseif (typeof(pas = $code_utils:parse_argspec(@args)) == LIST)
    argspec = pas[1];
    argspec[2] = $code_utils:full_prep(argspec[2]) || argspec[2];
    args = pas[2];
  else
    "... argspec is bogus ...";
    player:notify(tostr(pas));
    args = E_INVARG;
  endif
endwhile
if (upload)
  nflag = 0;
endif
if (args == E_INVARG)
  player:notify(tostr("Usage:  ", verb, " <object>:<verb> [<dobj> <prep> <iobj>] [with|without parentheses|numbers]"));
  return;
elseif ($command_utils:object_match_failed(object = player:my_match_object(spec[1]), spec[1]))
  return;
endif
what = object;
if (argspec)
  vnum = $code_utils:find_verb_named(what, spec[2], 0);
  while ((vnum < 0) ? valid(what = parent(what)) | (verb_args(what, vname = tostr(vnum)) != argspec))
    vnum = $code_utils:find_verb_named(what, spec[2], vnum + 1);
  endwhile
  code = (vnum < 0) ? E_VERBNF | verb_code(what, vname, pflag);
else
  vname = spec[2];
  while (valid(what) && ((code = verb_code(what, vname, pflag)) == E_VERBNF))
    what = parent(what);
  endwhile
endif
if (code == E_VERBNF)
  player:notify(tostr("That object does not define that verb", argspec ? " with those args." | "."));
elseif (typeof(code) == ERR)
  player:notify(tostr(code));
elseif (code == {})
  player:notify("That verb has not been programmed.");
elseif (!(lineseq = range ? $seq_utils:intersection(range, {1, length(code) + 1}) | {1, length(code) + 1}))
  player:notify("That verb has no lines in that range.");
else
  if ((what != object) && (!upload))
    player:notify(tostr("Object ", object, " does not define that verb", argspec ? " with those args" | "", ", but its ancestor ", what, " does."));
  endif
  info = verb_info(what, vname);
  vargs = verb_args(what, vname);
  if (index(vargs[2], "/"))
    vargs[2] = upload ? $code_utils:short_prep(vargs[2]) | tostr("(", vargs[2], ")");
  endif
  vargs = $string_utils:from_list(vargs, " ");
  vnames = $string_utils:print(info[3]);
  if (upload)
    (what != object) && player:notify(tostr("@verb ", object, ":", vnames, " ", vargs, " ", info[2] || "\"\""));
    player:notify(tostr("@program ", object, ":", spec[2], " ", argspec ? vargs | ""));
    (what != object) && player:notify(tostr("/* Definition from ", what, " */"));
  else
    player:notify(tostr(what, ":", vnames, "   ", vargs));
  endif
  for k in [1..length(lineseq) / 2]
    for i in [lineseq[(2 * k) - 1]..lineseq[2 * k] - 1]
      if (nflag)
        player:notify(tostr(" "[1..i < 10], i, ":  ", code[i]));
      else
        player:notify(code[i]);
      endif
      $command_utils:suspend_if_needed(0);
    endfor
  endfor
  if (upload)
    player:notify(".");
  endif
endif

@nn(old)

Spec this none thisFlags rdOwner #6349Definer #5803

Referenced by

none

Source

"@nn  -- reads the first new message on the first mail_recipient (in .current_message) where new mail exists.";
set_task_perms(player);
cm = this.current_message;
cm[1..2] = {};
for n in (cm)
  if ((n[3] < n[1].last_msg_date) && ((nlength = n[1]:length_all_msgs()) && ((next = n[1]:length_date_le(n[3]) + 1) <= nlength)))
    this:set_current_folder(folder = n[1]);
    this._mail_task = task_id();
    cur = folder:display_seq_full({next, next + 1}, tostr("Message %d", " on ", $mail_agent:name(folder), ":"));
    this:set_current_message(folder, @cur);
    return;
  endif
endfor
player:tell("No News (is good news)");

page

Spec any any anyFlags rxOwner #24442Definer #5803

Referenced by

• #33337:'* line 14: this:page
• #8855:'* line 11: this:page

Source

"Copied from Puff (#1449):multipage Sun Apr 25 11:37:19 1993 PDT";
"Copied from Experimental Guinea Pig Class with Even More Features of Dubious Utility (#5803):page by Geust (#24442) Mon Apr 19 17:40:02 1993 PDT";
"Usage:  page <player[s]>[ [with ]<message>]";
"If paging multiple players, the list must be in quotation marks.";
"Send a usage message if no arguments are given.";
nargs = length(args);
if (nargs < 1)
  player:notify(tostr("Usage: ", verb, " <player[s]> [[with ]<message>]"));
  return;
endif
"Parse and match the names of the recipients.";
who_all = $string_utils:match_player(names = $string_utils:explode(args[1]));
if ($command_utils:player_match_result(who_all, names)[1])
  return;
endif
who_all = $list_utils:remove_duplicates(who_all);
"Check for gagged recipients.";
if (gagged = $set_utils:intersection(this.gaglist, who_all))
  if (length(gagged) > 1)
    player:notify(tostr("You have ", $string_utils:title_list(gagged), " @gagged.  If you paged them, they wouldn't be able to answer you."));
  else
    player:notify($string_utils:pronoun_sub("You have %n @gagged.  If you paged %o, %s wouldn't be able to answer you.", gagged[1]));
  endif
  return;
endif
"Get the pager's page_origin_msg.";
header = player:page_origin_msg();
"Build the text of the message.";
text = "";
if (nargs > 1)
  if (argstr[1] == "\"")
    argstr[1..1] = "";
    argstr[1..index(argstr, "\"") + 1] = "";
  else
    argstr[1..index(argstr, " ")] = "";
  endif
  while (argstr[1] == " ")
    argstr[1..1] = "";
  endwhile
  if ((index(argstr, "with ") == 1) && (nargs > 2))
    argstr[1..5] = "";
    while (argstr[1] == " ")
      argstr[1..1] = "";
    endwhile
  endif
  if (((length(argstr) > 1) && (index(argstr, "\"") == 1)) && (rindex(argstr, "\"") == length(argstr)))
    "Strip excess quotes.";
    argstr = argstr[2..$ - 1];
  endif
  text = tostr($string_utils:pronoun_sub(($string_utils:index_delimited(header, player.name) ? "%S" | "%N") + " %<pages>, \""), argstr, "\"");
endif
iobj = player;
"Get the vanilla page_echo_msg for comparison later.";
if (length(who_all) == 1)
  dobj = who_all[1];
endif
pem = $player.page_echo_msg;
"Send the page.";
echoes = {};
refused = {};
unconnected = {};
for who in (who_all)
  "for pronoun_sub's benefit...";
  dobj = who;
  text ? response = who:receive_page(header, text) | (response = who:receive_page(header));
  if (response == 0)
    refused = {@refused, who};
  elseif (response == 2)
    unconnected = {@unconnected, who};
  elseif (response == 1)
    echoes = {@echoes, who};
  else
    echoes = {@echoes, who};
  endif
endfor
"Get the page_echo_msg for each player who received the page.";
vanilla = {};
idle = {};
for who in (echoes)
  "Get the page_echo_msg";
  dobj = who;
  echo = who:page_echo_msg();
  if (echo == pem)
    "If the echo is equal to a vanilla, standard echo, add the player to vanilla.";
    vanilla = {@vanilla, who};
  elseif (subs = match(echo, "Your message has been sent%.  %(.+%( seems? to be .+%)%), though%."))
    "If it's vanilla with an idle message on the end, add the player to vanilla, but also add the player and idle message to idle.";
    vanilla = {@vanilla, who};
    idle = {@idle, tostr(substitute("%1", subs))};
  else
    "If it's neither, then pass the echo to the pager.";
    player:notify(echo);
  endif
endfor
"Build a message to handle the players with vanilla echoes.";
if (length(who_all) > 1)
  vanilla_echo = ("Your message was received by " + $string_utils:title_list(vanilla)) + ".";
else
  vanilla_echo = "Your message has been sent.";
endif
if (length(idle) == 1)
  vanilla_echo = ((vanilla_echo + "  ") + idle[1]) + ", though.";
elseif (length(idle) > 1)
  vanilla_echo = (vanilla_echo + $string_utils:english_listc(idle)) + ", though.";
endif
if (length(vanilla) > 0)
  "Tell it to the player.";
  player:notify(vanilla_echo);
endif
"Handle refused messages.";
if (length(refused) > 0)
  player:notify(tostr($string_utils:title_listc(refused), " refused your message."));
endif
"Handle unconnected messages.";
if (length(unconnected) > 1)
  player:notify(tostr($string_utils:title_listc(unconnected), " are not currently logged in."));
elseif (length(unconnected) == 1)
  message = unconnected[1]:page_absent_msg();
  if (typeof(message) != STR)
    message = $string_utils:pronoun_sub("%N is not currently logged in.", unconnected[1]);
  endif
  player:notify(message);
endif

page(old)

Spec any any anyFlags rxOwner #24442Definer #5803

Referenced by

none

Source

"Usage:  page <player[s]>[ [with ]<message>]";
"If paging multiple players, the list must be in quotation marks.";
nargs = length(args);
if (nargs < 1)
  player:notify(tostr("Usage: ", verb, " <player[s]> [[with ]<message>]"));
  return;
endif
who_all = $string_utils:match_player(names = $string_utils:explode(args[1]));
if ($command_utils:player_match_result(who_all, names)[1])
  return;
endif
who_all = $list_utils:remove_duplicates(who_all);
for who in (who_all)
  if (!(who in connected_players()))
    unconnected = {1};
    if (msg = who:page_absent_msg())
      player:notify(msg);
    else
      unconnected = setadd(unconnected, who);
    endif
  endif
endfor
if (unconnected)
  if (unconnected = listdelete(unconnected, 1))
    if (length(unconnected) > 1)
      player:notify(tostr($string_utils:title_listc(unconnected), " are not currently logged in."));
    else
      player:notify($string_utils:pronoun_sub("%N %<is> not currently logged in."), unconnected[1]);
    endif
  endif
  return;
endif
if (gagged = $set_utils:intersection(this.gaglist, who_all))
  if (length(gagged) > 1)
    player:notify(tostr("You have ", $string_utils:title_list(gagged), " @gagged.  If you paged them, they wouldn't be able to answer you."));
  else
    player:notify($string_utils:pronoun_sub("You have %n @gagged.  If you paged %o, %s wouldn't be able to answer you.", gagged[1]));
  endif
  return;
endif
text = "";
if (nargs > 1)
  if (argstr[1] == "\"")
    argstr[1..1] = "";
    argstr[1..index(argstr, "\"") + 1] = "";
  else
    argstr[1..index(argstr, " ")] = "";
  endif
  while (argstr[1] == " ")
    argstr[1..1] = "";
  endwhile
  if ((index(argstr, "with ") == 1) && (nargs > 2))
    argstr[1..5] = "";
    while (argstr[1] == " ")
      argstr[1..1] = "";
    endwhile
  endif
  text = tostr($string_utils:pronoun_sub(($string_utils:index_delimited(player:page_origin_msg(), player.name) ? "%S" | "%N") + " %<pages>, \""), argstr, "\"");
endif
iobj = player;
pem = $player.page_echo_msg;
standard_echo = 0;
for who in (who_all)
  "for pronoun_sub's benefit...";
  dobj = who;
  header = player:page_origin_msg();
  text ? who:receive_page(header, text) | who:receive_page(header);
  echo = who:page_echo_msg();
  if (echo == pem)
    standard_echo = standard_echo + 1;
  elseif (subs = $match(echo, "Your message has been sent%.  %(.+%( seems? to be .+%)%), though%."))
    standard_echo = standard_echo + 1;
    if (idles)
      idles = listappend(idles, tostr(who:title(), substitute("%2", subs)));
    else
      idles = {substitute("%1", subs)};
    endif
  else
    player:notify(echo);
  endif
endfor
if (standard_echo)
  if (standard_echo > 1)
    pem = tostr("Your message has been sent (", standard_echo, " times).");
  endif
  if (idles)
    pem = tostr(pem, "  ", $string_utils:english_list(idles), ", though.");
  endif
  player:notify(pem);
endif

plus(old)

Spec this none thisFlags rdDefiner #5803

Referenced by

none

Source

"Copied from Experimental Guinea Pig Class with Even More Features of Dubious Utility (#5803):+ by Jay (#3920) Tue Jun 28 16:05:11 1994 PDT";
"Copied from Puff (#1449):+ Sun Apr 25 11:31:11 1993 PDT";
"Copied from Experimental Guinea Pig Class with Even More Features of Dubious Utility (#5803):+ by Jonny (#3920) Fri Apr 23 20:04:14 1993 PDT";
"<Quinn's Page-Emote>";
"Usage: +<player> <emote>";
"   or: ++<player> <emote>  (possesive format)";
"";
"Example: +Voluptua licks hungrily at your inner thigh.";
"  Shows: (from Nut-Hut) Glub licks hungrily at your inner thigh.";
if ((!args) && (length(verb) < 3))
  player:tell("Usage: + <player> <emote> || ++ <player> <emote>");
  return;
endif
nargs = length(args);
vl = length(verb);
if ((verb == "+") || (verb == "++"))
  sf = args[1];
  ms_str = $string_utils:from_list(args[2..nargs], " ");
else
  sf = verb[rindex(verb, "+") + 1..vl];
  ms_str = argstr;
endif
who = $string_utils:match_player(sf);
if ($command_utils:player_match_result(who, sf)[1])
  return;
else
  "pr = this:ep_prefix_msg();";
  pr = $string_utils:pronoun_sub(this.remote_emote_prefix_msg);
  div = index(verb, "++") ? "" | " ";
  result = who:receive_page(tostr(pr, " ", player.name, div, ms_str));
  if (result == 2)
    player:tell(who.name, " isn't connected.");
  elseif (result == 1)
    player:tell(who.name, " has received your emote.");
  else
    player:tell(result);
    player:tell(who.name, " refused your emote.");
  endif
endif

pc_option

Spec this none thisDefiner #5803

Referenced by

none

Source

return 0;

make_current_message(old)

Spec this none thisFlags rxdOwner #89987Definer #5803

Referenced by

none

Source

":make_current_message(recipient[,index])";
"starts a new current_message record for recipient.";
"index, if given, indicates where recipient is to be";
"  placed (n = at or after nth entry in .current_message).";
recip = args[1];
for x in (listdelete(this.idle_messages, 1))
  if (x[1] == recip)
    this.idle_messages = setremove(this.idle_messages, x);
    this.current_message = setadd(this.current_message, x);
  endif
endfor
cm = this.current_message;
if (length(args) > 1)
  i = max(2, min(args[2], length(cm)));
else
  i = 0;
endif
if ((caller != this) && (!$perm_utils:controls(caller_perms(), this)))
  return $error:raise(E_PERM);
elseif (recip == this)
  "...self...";
elseif (j = $list_utils:iassoc(recip, cm))
  "...already present...";
  if (i)
    if (j < i)
      this.current_message = {@cm[1..j - 1], @cm[j + 1..i], cm[j], @cm[i + 1..length(cm)]};
    elseif (j > (i + 1))
      this.current_message = {@cm[1..i], cm[j], @cm[i + 1..j - 1], @cm[j + 1..length(cm)]};
    endif
  endif
else
  this.current_message = listappend(cm, {recip, 0, 0}, @i ? {i} | {});
endif

set_current_message(old)

Spec this none thisFlags rxdOwner #89987Definer #5803

Referenced by

none

Source

":set_current_message(recipient[,number[,date]])";
"Returns the new {number,last-read-date} pair for recipient.";
if ((caller != this) && (!$perm_utils:controls(caller_perms(), this)))
  return $error:raise(E_PERM);
endif
recip = args[1];
for x in (listdelete(this.idle_messages, 1))
  if (x[1] == recip)
    this.idle_messages = setremove(this.idle_messages, x);
    this.current_message = setadd(this.current_message, x);
  endif
endfor
number = {@args, E_NONE}[2];
date = {@args, 0, 0}[3];
cm = this.current_message;
if (recip == this)
  this.current_message[2] = max(date, cm[2]);
  if (number != E_NONE)
    this.current_message[1] = number;
  endif
  return this.current_message[1..2];
elseif (i = $list_utils:iassoc(recip, cm))
  return (this.current_message[i] = {recip, (number == E_NONE) ? cm[i][2] | number, max(date, cm[i][3])})[2..3];
else
  entry = {recip, (number != E_NONE) && number, date};
  this.current_message = {@cm, entry};
  return entry[2..3];
endif

kill_current_message(old)

Spec this none thisFlags rxdOwner #89987Definer #5803

Referenced by

none

Source

":kill_current_message(recipient)";
"entirely forgets current message for this recipient...";
"Returns true iff successful.";
if ((caller != this) && (!$perm_utils:controls(caller_perms(), this)))
  return $error:raise(E_PERM);
elseif ((recip = args[1]) == this)
  return;
elseif (i = $list_utils:iassoc(recip, cm = this.current_message))
  this.current_message = listdelete(cm, i);
  return 1;
elseif (i = $list_utils:iassoc(recip, cm = this.idle_messages))
  this.idle_messages = listdelete(cm, i);
  return 1;
endif

get_current_message(old)

Spec this none thisFlags rxdOwner #89987Definer #5803

Referenced by

none

Source

":get_current_message([recipient])";
" => {msg_num, last_read_date} for the given recipient.";
" => 0 if we have no record of that recipient.";
if ((caller != this) && (!$perm_utils:controls(caller_perms(), this)))
  $error:raise(E_PERM);
elseif ((!args) || (args[1] == this))
  if (length(this.current_message) < 2)
    "Whoops, this got trashed---fix it up!";
    this.current_message = {0, time(), @this.current_message};
  endif
  return this.current_message[1..2];
elseif (a = $list_utils:assoc_suspended(args[1], this.current_message))
  return a[2..3];
elseif (a = $list_utils:assoc_suspended(args[1], this.idle_messages))
  return a[2..3];
else
  return 0;
endif

update_idle_lists(old)

Spec none none noneFlags rxdOwner #89987Definer #5803

Referenced by

none

Source

if ((caller == this) || $perm_utils:controls(caller_perms(), this))
  set_task_perms(this.owner);
  thr = time() - this:mail_option("idle_threshold");
  idle = this.idle_messages;
  current = this.current_message;
  c = $list_utils:slice(current[3..length(current)], 1);
  for x in (listdelete(idle, 1))
    if (x[1] in c)
      idle = setremove(idle, x);
    endif
  endfor
  for x in ({@idle, @current})
    if (typeof(x) == LIST)
      rcpt = x[1];
      if ($mail_agent:is_recipient(rcpt))
        if (rcpt == $news)
          this.idle_messages = setremove(this.idle_messages, x);
          this.current_message = setadd(this.current_message, x);
        elseif ((rcpt.last_msg_date < thr) && (rcpt.last_msg_date <= x[3]))
          this.idle_messages = setadd(this.idle_messages, x);
          this.current_message = setremove(this.current_message, x);
        else
          this.idle_messages = setremove(this.idle_messages, x);
          this.current_message = setadd(this.current_message, x);
        endif
      else
        this.idle_messages = setremove(this.idle_messages, x);
        this.current_message = setremove(this.current_message, x);
        player:notify(tostr("Bogus recipient ", rcpt, " removed from your subscription lists."));
      endif
      $command_utils:suspend_if_needed(0);
    endif
  endfor
  if (verb == "@update-mail")
    player:notify("Idle mail lists updated.");
  endif
  this.idle_messages[1] = time();
endif