code utilities (#60)

":eval_d(code...) => {compiled?,result}";
"This works exactly like the builtin eval() except that the code is evaluated ";
"as if the d flag were unset.";
code = {"set_verb_code(this,\"1\",{\"\\\"Do not remove this verb!  This is an auxiliary 
verb for :eval_d().\\\";\"});", "dobj=iobj=this=#-1;", "dobjstr=iobjstr=prepstr=argstr=verb=\"\";", 
tostr("caller=", caller, ";"), "set_task_perms(caller_perms());", @args};
if (!caller_perms().programmer)
    return E_PERM;
elseif (svc = set_verb_code(this, "1", code))
    lines = {};
    for line in (svc)
        if ((index(line, "Line ") == 1) && (n = tonum(line[6..(colon = index(line 
+ ":", ":")) - 1])))
            lines = {@lines, tostr("Line ", n - 5, line[colon..length(line)])};
        else
            lines = {@lines, line};
        endif
    endfor
    return {0, lines};
else
    set_task_perms(caller_perms());
    return {1, this:("1")()};
endif
.

"Do not remove this verb!  This is an auxiliary verb for :eval_d().";
.

":tonum(number as string) => number";
return match(s = args[1], "^ *[-+]?[0-9]+ *$") ? tonum(s) | E_TYPE;
.

":toobj(objectid as string) => objectid";
return match(s = args[1], "^ *#[-+]?[0-9]+ *$") ? toobj(s) | E_TYPE;
.

"toerr(n), toerr(\"E_FOO\"), toerr(\"FOO\") => E_FOO.";
if (typeof(s = args[1]) != STR)
    n = tonum(s) + 1;
    if (n > length(this.error_list))
        return 1;
    endif
elseif (!(n = (s in this.error_names) || (("E_" + s) in this.error_names)))
    return 1;
endif
return this.error_list[n];
.

"error_name(E_FOO) => \"E_FOO\"";
return this.error_names[tonum(args[1]) + 1];
.

set_task_perms(caller_perms());
object = args[1];
what = {@args, {"props", "verbs"}}[2];
player:notify(tostr("Object ID:  ", object));
player:notify(tostr("Name:       ", object.name));
names = {"Parent", "Location", "Owner"};
vals = {parent(object), object.location, object.owner};
for i in [1..length(vals)]
    if (!valid(vals[i]))
        val = "*** NONE ***";
    else
        val = ((vals[i].name + " (") + tostr(vals[i])) + ")";
    endif
    player:notify(tostr(names[i], ":      "[1..12 - length(names[i])], val));
endfor
line = "Flags:     ";
if (is_player(object))
    line = line + " player";
endif
for flag in ({"programmer", "wizard", "r", "w", "f"})
    if (object.(flag))
        line = (line + " ") + flag;
    endif
endfor
player:notify(line);
if (player.programmer && ((player.wizard || (player == object.owner)) || object.r))
    if (("verbs" in what) && verbs(object))
        player:notify("Verb definitions:");
        for v in (verbs(object))
            $command_utils:suspend_if_needed(0);
            player:notify(tostr("    ", v));
        endfor
    endif
    if ("props" in what)
        if (properties(object))
            player:notify("Property definitions:");
            for p in (properties(object))
                $command_utils:suspend_if_needed(0);
                player:notify(tostr("    ", p));
            endfor
        endif
        all_props = $object_utils:all_properties(object);
        if (all_props != {})
            player:notify("Properties:");
            for p in (all_props)
                $command_utils:suspend_if_needed(0);
                val = object.(p);
                if (val == E_PERM)
                    STR = "(Permission denied.)";
                else
                    STR = $string_utils:from_value_suspended(val, 1, -1);
                endif
                player:notify(tostr("    ", p, ": ", STR));
            endfor
        endif
    endif
elseif (player.programmer)
    player:notify("** Can't list properties or verbs: permission denied.");
endif
if (object.contents)
    player:notify("Contents:");
    for o in (object.contents)
        $command_utils:suspend_if_needed(0);
        player:notify(tostr("    ", o.name, " (", o, ")"));
    endfor
endif
.

set_task_perms(caller_perms());
object = args[1];
pname = args[2];
if (pname in this.builtin_props)
    player:notify(tostr(object, ".", pname));
    player:notify("Built-in property.");
else
    info = property_info(object, pname);
    if (typeof(info) == ERR)
        player:notify(tostr(info));
        return;
    endif
    owner = info[1];
    perms = info[2];
    player:notify(tostr(object, ".", pname));
    player:notify(tostr("Owner:        ", valid(owner) ? tostr(owner.name, " (", 
owner, ")") | "*** NONE ***"));
    player:notify(tostr("Permissions:  ", perms));
endif
player:notify(tostr("Value:        ", $string_utils:print(object.(pname))));
.

set_task_perms(caller_perms());
object = args[1];
vname = args[2];
if (!(hv = $object_utils:has_verb(object, vname)))
    player:notify("That object does not define that verb.");
    return;
elseif (hv[1] != object)
    player:notify(tostr("Object ", object, " does not define that verb, but its ancestor 
", hv[1], " does."));
    object = hv[1];
endif
info = verb_info(object, vname);
if (typeof(info) == ERR)
    player:notify(tostr(info));
    return;
endif
owner = info[1];
perms = info[2];
names = info[3];
arg_specs = verb_args(object, vname);
player:notify(tostr(object, ":", names));
player:notify(tostr("Owner:            ", valid(owner) ? tostr(owner.name, " (", 
owner, ")") | "*** NONE ***"));
player:notify(tostr("Permissions:      ", perms));
player:notify(tostr("Direct Object:    ", arg_specs[1]));
player:notify(tostr("Preposition:      ", arg_specs[2]));
player:notify(tostr("Indirect Object:  ", arg_specs[3]));
.

if (args[4..5] == {"none", "this"})
    return 0;
endif
thisobj = args[1];
verb = args[2];
adobj = args[3];
aprep = args[4];
aiobj = args[5];
prep_part = (aprep == "any") ? "to" | this:short_prep(aprep);
".........`any' => `to' (arbitrary),... `none' => empty string...";
if ((adobj == "this") && (dobj == thisobj))
    dobj_part = dobjstr;
    iobj_part = ((!prep_part) || (aiobj == "none")) ? "" | ((aiobj == "this") ? dobjstr 
| iobjstr);
elseif ((aiobj == "this") && (iobj == thisobj))
    dobj_part = (adobj == "any") ? dobjstr | ((adobj == "this") ? iobjstr | "");
    iobj_part = iobjstr;
elseif (!("this" in args[3..5]))
    dobj_part = (adobj == "any") ? dobjstr | "";
    iobj_part = (prep_part && (aiobj == "any")) ? iobjstr | "";
else
    return 0;
endif
return tostr(verb, dobj_part ? " " + dobj_part | "", prep_part ? " " + prep_part 
| "", iobj_part ? " " + iobj_part | "");
.

"returns the permissions of the current verb (either the owner or the result of the 
most recent set_task_perms()).";
return caller_perms();
.

"returns the object where the current verb is defined.";
return callers()[1][4];
.

":verb_documentation([object,verbname]) => documentation at beginning of verb code, 
if any";
"default is the calling verb";
set_task_perms(caller_perms());
if (args)
    object = args[1];
    vname = args[2];
else
    c = callers()[1];
    object = c[4];
    vname = c[2];
endif
if (typeof(code = verb_code(object, vname)) == ERR)
    return tostr(code);
else
    doc = {};
    for line in (code)
        if (match(line, "^\"%([^\\\"]%|\\.%)*\";$"))
            "... now that we're sure `line' is just a string, eval() is safe...";
            doc = {@doc, $no_one:eval("; return " + line)[2]};
        else
            return doc;
        endif
    endfor
    return doc;
endif
.

":set_verb_documentation(object,verbname,text)";
"  changes documentation at beginning of verb code";
"  text is either a string or a list of strings";
"  returns a non-1 value if anything bad happens...";
set_task_perms(caller_perms());
if (typeof(code = verb_code(object = args[1], vname = args[2])) == ERR)
    return code;
elseif (typeof(vd = $code_utils:verb_documentation(object, vname)) == ERR)
    return vd;
elseif (!(typeof(text = args[3]) in {LIST, STR}))
    return E_INVARG;
else
    newdoc = {};
    for l in ((typeof(text) == LIST) ? text | {text})
        if (typeof(l) != STR)
            return E_INVARG;
        endif
        newdoc = {@newdoc, $string_utils:print(l) + ";"};
    endfor
    if ((ERR == typeof(svc = set_verb_code(object, vname, {@newdoc, @code[length(vd) 
+ 1..length(code)]}))) || svc)
        "... this shouldn't happen.  I'm not setting this code -d just yet...";
        return svc;
    else
        return 1;
    endif
endif
.

"$code_utils:parse_propref(string)";
"Parses string as a MOO-code property reference, returning {object-string, prop-name-string} 
for a successful parse and false otherwise.  It always returns the right object-string 
to pass to, for example, this-room:match_object.";
s = args[1];
if (dot = index(s, "."))
    object = s[1..dot - 1];
    prop = s[dot + 1..length(s)];
    if ((object == "") || (prop == ""))
        return 0;
    elseif (object[1] == "$")
        object = #0.(object[2..length(object)]);
        if (typeof(object) != OBJ)
            return 0;
        endif
        object = tostr(object);
    endif
elseif (index(s, "$") == 1)
    object = "#0";
    prop = s[2..length(s)];
else
    return 0;
endif
return {object, prop};
.

"$code_utils:parse_verbref(string)";
"Parses string as a MOO-code verb reference, returning {object-string, verb-name-string} 
for a successful parse and false otherwise.  It always returns the right object-string 
to pass to, for example, this-room:match_object().";
s = args[1];
if (colon = index(s, ":"))
    object = s[1..colon - 1];
    verbname = s[colon + 1..length(s)];
    if (!(object && verbname))
        return 0;
    elseif ((object[1] == "$") && 0)
        "Why was this check taking place here? -- from jhm";
        pname = object[2..length(object)];
        if ((!(pname in properties(#0))) || (typeof(object = #0.(pname)) != OBJ))
            return 0;
        endif
        object = tostr(object);
    endif
    return {object, verbname};
else
    return 0;
endif
.

":parse_arg_spec(@args)";
"  attempts to parse the given sequence of args into a verb_arg specification";
"returns {verb_args,remaining_args} if successful.";
"  e.g., :parse_arg_spec(\"this\",\"in\",\"front\",\"of\",\"any\",\"foo\"..)";
"           => {{\"this\",\"in front of\",\"any\"},{\"foo\"..}}";
"returns a string error message if parsing fails.";
nargs = length(args);
if (nargs < 1)
    return {{}, {}};
elseif ((ds = args[1]) == "tnt")
    return {{"this", "none", "this"}, listdelete(args, 1)};
elseif (!(ds in {"this", "any", "none"}))
    return tostr("\"", ds, "\" is not a valid direct object specifier.");
elseif ((nargs < 2) || (args[2] in {"none", "any"}))
    verbargs = args[1..min(3, nargs)];
    rest = args[4..nargs];
elseif (!(gp = $code_utils:get_prep(@args[2..nargs]))[1])
    return tostr("\"", args[2], "\" is not a valid preposition.");
else
    verbargs = {ds, @gp[1..min(2, nargs = length(gp))]};
    rest = gp[3..nargs];
endif
if ((length(verbargs) >= 3) && (!(verbargs[3] in {"this", "any", "none"})))
    return tostr("\"", verbargs[3], "\" is not a valid indirect object specifier.");
endif
return {verbargs, rest};
.

if (server_version() != this._version)
    this:_fix_preps();
endif
return this.prepositions;
.

":short_prep(p) => shortest preposition equivalent to p";
"p may be a single word or one of the strings returned by verb_args().";
if (server_version() != this._version)
    this:_fix_preps();
endif
word = args[1];
word = word[1..index(word + "/", "/") - 1];
if (p = word in this._other_preps)
    return this._short_preps[this._other_preps_n[p]];
elseif (word in this._short_preps)
    return word;
else
    return "";
endif
.

if (server_version() != this._version)
    this:_fix_preps();
endif
prep = args[1];
if (p = prep in this._short_preps)
    return this.prepositions[p];
elseif (p = prep in this._other_preps)
    return this.prepositions[this._other_preps_n[p]];
else
    return "";
endif
.

":get_prep(@args) extracts the prepositional phrase from the front of args, returning 
a list consisting of the preposition (or \"\", if none) followed by the unused args.";
":get_prep(\"in\",\"front\",\"of\",...) => {\"in front of\",...}";
":get_prep(\"inside\",...)          => {\"inside\",...}";
":get_prep(\"frabulous\",...}       => {\"\", \"frabulous\",...}";
prep = "";
allpreps = {@this._short_preps, @this._other_preps};
rest = 1;
for i in [1..length(args)]
    try_ = (i == 1) ? args[1] | tostr(try_, " ", args[i]);
    if (try_ in allpreps)
        prep = try_;
        rest = i + 1;
    endif
    if (!(try_ in this._multi_preps))
        return {prep, @args[rest..length(args)]};
    endif
endfor
return {prep, @args[rest..length(args)]};
.

":_fix_preps() updates the properties on this having to do with prepositions.";
"_fix_preps should be called whenever we detect that a new server version has been 
installed.";
orig_args = verb_args(this, verb);
multis = nothers = others = shorts = longs = {};
i = 0;
while (typeof(set_verb_args(this, verb, {"this", tostr(i), "this"})) != ERR)
    l = verb_args(this, verb)[2];
    all = $string_utils:explode(l, "/");
    s = all[1];
    for p in (listdelete(all, 1))
        if (length(p) <= length(s))
            s = p;
        endif
    endfor
    for p in (all)
        while (j = rindex(p, " "))
            multis = {p = p[1..j - 1], @multis};
        endwhile
    endfor
    longs = {@longs, l};
    shorts = {@shorts, s};
    others = {@others, @setremove(all, s)};
    nothers = {@nothers, @$list_utils:make(length(all) - 1, length(shorts))};
    i = i + 1;
endwhile
set_verb_args(this, verb, orig_args);
this.prepositions = longs;
this._short_preps = shorts;
this._other_preps = others;
this._other_preps_n = nothers;
this._multi_preps = multis;
this._version = server_version();
return;
.

":find_verb_named(object,name[,n])";
"  returns the *number* of the first verb on object matching the given name.";
"  optional argument n, if given, starts the search with verb n,";
"  causing the first n verbs (0..n-1) to be ignored.";
"  -1 is returned if no verb is found.";
"  This routine does not find inherited verbs.";
object = args[1];
name = args[2];
for i in [{@args, 0}[3]..length(verbs(object)) - 1]
    verbinfo = verb_info(object, tostr(i));
    if (this:verbname_match(verbinfo[3], name))
        return i;
    endif
endfor
return -1;
.

":find_verb_named(object,name[,n])";
"  returns the *number* of the last verb on object matching the given name.";
"  optional argument n, if given, starts the search with verb n-1,";
"  causing verbs (n..length(verbs(object))) to be ignored.";
"  -1 is returned if no verb is found.";
"  This routine does not find inherited verbs.";
object = args[1];
name = args[2];
last = {@args, -1}[3];
if (last < 0)
    last = length(verbs(object));
endif
for i in [1..last]
    verbinfo = verb_info(object, tostr(last - i));
    if (this:verbname_match(verbinfo[3], name))
        return last - i;
    endif
endfor
return -1;
.

":find_callable_verb_named(object,name[,n])";
"  returns the *number* of the first verb on object that matches the given";
"  name and has the x flag set.";
"  optional argument n, if given, starts the search with verb n,";
"  causing the first n verbs (0..n-1) to be ignored.";
"  -1 is returned if no verb is found.";
"  This routine does not find inherited verbs.";
object = args[1];
name = args[2];
for i in [{@args, 0}[3]..length(verbs(object)) - 1]
    verbinfo = verb_info(object, tostr(i));
    if (index(verbinfo[2], "x") && this:verbname_match(verbinfo[3], name))
        return i;
    endif
endfor
return -1;
.

"$code_utils:find_verbs_containing(pattern[,object|object-list])";
"";
"Print (to player) the name and owner of every verb in the database whose code contains 
PATTERN as a substring.  Optional second argument limits the search to the specified 
object or objects.";
"";
"Because it searches the entire database, this function may suspend the task several 
times before returning.";
"";
set_task_perms(caller_perms());
"... puts the task in a player's own job queue and prevents someone from learning 
about verbs that are otherwise unreadable to him/her.";
pattern = args[1];
where = {@args, 0}[2];
count = 0;
if (typeof(where) == NUM)
    for i in [where..tonum(max_object())]
        if (valid(o = toobj(i)))
            count = count + this:_find_verbs_containing(pattern, o);
        endif
        if ($command_utils:running_out_of_time())
            player:notify(tostr("...", o));
            suspend(0);
        endif
    endfor
elseif (typeof(where) == LIST)
    for o in (where)
        count = count + this:_find_verbs_containing(pattern, o);
    endfor
else
    "...typeof(where) == OBJ...";
    count = this:_find_verbs_containing(pattern, where);
endif
player:notify("");
player:notify(tostr("Total: ", count, " verbs."));
.

":_find_verbs_containing(pattern,object)";
"number of verbs in object with code having a line containing pattern";
"prints verbname and offending line to player";
set_task_perms(caller_perms());
pattern = args[1];
count = 0;
verbs = verbs(o = args[2]);
if (typeof(verbs) == ERR)
    player:notify(tostr("verbs(", o, ") => ", verbs));
    return 0;
endif
for vnum in [0..length(verbs) - 1]
    if (l = this:_grep_verb_code(pattern, o, vname = tostr(vnum)))
        owner = verb_info(o, vname)[1];
        player:notify(tostr(o, ":", verbs[vnum + 1], " [", valid(owner) ? owner.name 
| "Recycled Player", " (", owner, ")]:  ", l));
        count = count + 1;
    endif
    if ($command_utils:running_out_of_time())
        player:notify(tostr("...", o));
        suspend(0);
    endif
endfor
return count;
.

"$code_utils:find_verbs_matching(pattern[,object|object-list])";
"";
"Print (to player) the name and owner of every verb in the database whose code has 
a substring matches the regular expression PATTERN.  Optional second argument limits 
the search to the specified object or objects.";
"";
"Because it searches the entire database, this function may suspend the task several 
times before returning.";
"";
set_task_perms(caller_perms());
"... puts the task in a player's own job queue and prevents someone from learning 
about verbs that are otherwise unreadable to him/her.";
pattern = args[1];
where = {@args, 0}[2];
count = 0;
if (typeof(where) == NUM)
    for i in [where..tonum(max_object())]
        if (valid(o = toobj(i)))
            count = count + this:_find_verbs_matching(pattern, o);
        endif
        if ($command_utils:running_out_of_time())
            player:notify(tostr("...", o));
            suspend(0);
        endif
    endfor
elseif (typeof(where) == LIST)
    for o in (where)
        count = count + this:_find_verbs_matching(pattern, o);
    endfor
else
    count = this:_find_verbs_matching(pattern, args[2]);
endif
player:notify("");
player:notify(tostr("Total: ", count, " verbs."));
.

":_find_verbs_matching(regexp,object)";
"number of verbs in object with code having a line matching regexp";
"prints verbname and offending line to player";
set_task_perms(caller_perms());
pattern = args[1];
count = 0;
verbs = verbs(o = args[2]);
if (typeof(verbs) == ERR)
    player:notify(tostr("verbs(", o, ")  => ", verbs));
    return 0;
endif
for vnum in [0..length(verbs) - 1]
    if (l = this:_egrep_verb_code(pattern, o, vname = tostr(vnum)))
        owner = verb_info(o, vname)[1];
        player:notify(tostr(o, ":", verbs[vnum + 1], " [", valid(owner) ? owner.name 
| "Recycled Player", " (", owner, ")]:  ", l));
        count = count + 1;
    endif
    if ($command_utils:running_out_of_time())
        player:notify(tostr("...", o));
        suspend(0);
    endif
endfor
return count;
.

":_grep_verb_code(pattern,object,verbname) => line number or 0";
"  returns line number on which pattern occurs in code for object:verbname";
set_task_perms(caller_perms());
pattern = args[1];
for line in (vc = verb_code(@listdelete(args, 1)))
    if (index(line, pattern))
        return line;
    endif
endfor
return 0;
.

":_egrep_verb_code(regexp,object,verbname) => 0 or line number";
"  returns line number of first line matching regexp in object:verbname code";
set_task_perms(caller_perms());
pattern = args[1];
for line in (vc = verb_code(@listdelete(args, 1)))
    if (match(line, pattern))
        return line;
    endif
endfor
return 0;
.

"Parse [from ] [to ] [for ].";
"Takes a series of strings, most likely @args with dobjstr removed.";
"Returns a list {NUM start, NUM end, STR name}, or {} if there is an error.";
fail = length(args) % 2;
start = 0;
end = tonum(max_object());
match = "";
while (args && (!fail))
prep = args[1];
if (prep == "from")
    if ((start = player.location:match_object(args[2])) >= #0)
        start = tonum(start);
    else
        start = tonum(args[2]);
    endif
elseif (prep == "to")
    if ((end = player.location:match_object(args[2])) >= #0)
    end = tonum(end);
else
end = tonum(args[2]);
endif
elseif (prep == "for")
match = args[2];
else
fail = 1;
endif
args = args[3..length(args)];
endwhile
return fail ? {} | {start, end, match};
.

olist = {player, @$object_utils:ancestors(player)};
if (valid(player.location))
    olist = {@olist, player.location, @$object_utils:ancestors(player.location)};
endif
dbs = {};
for o in (olist)
    h = o.help;
    if (typeof(h) == OBJ)
        h = {h};
    endif
    for db in (h)
        if ((typeof(db) == OBJ) && (valid(db) && (!(db in dbs))))
            dbs = {@dbs, db};
        endif
    endfor
endfor
return {@dbs, $help};
.

":help_db_search(string,dblist)";
"  searches each of the help db's in dblist for a topic matching string.";
"  Returns  {db,topic}  or  {$ambiguous_match,{topic...}}  or {}";
what = args[1];
dblist = args[2];
topics = {};
help = 1;
for db in (dblist)
    if ({what} == (ts = db:find_topics(what)))
        return {db, ts[1]};
    elseif (ts && (typeof(ts) == LIST))
        if (help)
            help = db;
        endif
        for t in (ts)
            topics = setadd(topics, t);
        endfor
    endif
endfor
if (length(topics) > 1)
    return {$ambiguous_match, topics};
elseif (topics)
    return {help, topics[1]};
else
    return {};
endif
.

":corify_object(object)  => string representing object";
"  usually just returns tostr(object), but in the case of objects that have";
"  corresponding #0 properties, return the appropriate $-string.";
object = args[1];
for p in (properties(#0))
    if (#0.(p) == object)
        return "$" + p;
    endif
endfor
return tostr(object);
.

"$code_utils:substitute(string,subs) => new line";
"Subs are a list of lists, {{\"target\",\"sub\"},{...}...}";
"Substitutes targets for subs in a delimited string fashion, avoiding substituting 
anything inside quotes, e.g. player:tell(\"don't sub here!\")";
s = args[1];
subs = args[2];
lets = "abcdefghijklmnopqrstuvwxyz0123456789";
for x in (subs)
    len = length(sub = x[1]);
    delimited = index(lets, sub[1]) && index(lets, sub[len]);
    prefix = "";
    while (i = index(s, sub))
        prefix = prefix + s[1..i - 1];
        if ((((prefix == "") || ((!delimited) || (!index(lets, prefix[length(prefix)])))) 
&& ((!delimited) || (((i + len) > length(s)) || (!index(lets, s[i + len]))))) && 
(!this:inside_quotes(prefix)))
            prefix = prefix + x[2];
        else
            prefix = prefix + s[i..(i + len) - 1];
        endif
        s = s[i + len..length(s)];
    endwhile
    s = prefix + s;
endfor
return s;
.

"See if the end of the string passed as args[1] ends 'inside' a doublequote.  Used 
by $code_utils:substitute.";
string = args[1];
quoted = 0;
for i in [1..length(string)]
    if ((string[i] == "\"") && ((!quoted) || (string[i - 1] != "\\")))
        quoted = !quoted;
    endif
endfor
return quoted;
.

"verb_or_property(,  [, @])";
"Looks for a callable verb or property named  on .";
"If  has a callable verb named  then return :()(@).";
"If  has a property named  then return .().";
"Otherwise return E_PROPNF.";
"N.B.: a verb returning E_VERBNF will act like an undefined verb.";
set_task_perms(caller_perms());
return ((val = args[1]:(args[2])(@args[3..length(args)])) == E_VERBNF) ? args[1].(args[2]) 
| val;
.

"task_valid(NUM id)";
"Return true iff there is currently a valid task with the given id.";
set_task_perms($no_one);
id = args[1];
return (id == task_id()) || (E_PERM == kill_task(id));
.

if (a = $list_utils:assoc(args[1], queued_tasks()))
    return a[5];
else
    return E_INVARG;
endif
.

":argstr(verb,args[,argstr]) => what argstr should have been.  ";
"Recall that the command line is parsed into a sequence of words; `verb' is";
"assigned the first word, `args' is assigned the remaining words, and argstr";
"is assigned a substring of the command line, which *should* be the one";
"starting first nonblank character after the verb, but is instead (because";
"the parser is BROKEN!) the one starting with the first nonblank character";
"after the first space in the line, which is not necessarily after the verb.";
"Clearly, if the verb contains spaces --- which can happen if you use";
"backslashes and quotes --- this loses, and argstr will then erroneously";
"have extra junk at the beginning.  This verb, given verb, args, and the";
"actual argstr, returns what argstr should have been.";
verb = args[1];
argstr = {@args, argstr}[3];
n = length(args = args[2]);
if (!index(verb, " "))
    return argstr;
elseif (!args)
    return "";
endif
"space in verb => two possible cases:";
"(1) first space was not in a quoted string.";
"    first word of argstr == rest of verb unless verb ended on this space.";
if ((nqargs = $string_utils:words(argstr)) == args)
    return argstr;
elseif (((nqn = length(nqargs)) == (n + 1)) && (nqargs[2..nqn] == args))
    return argstr[$string_utils:word_start(argstr)[2][1]..length(argstr)];
else
    "(2) first space was in a quoted string.";
    "    argstr starts with rest of string";
    qs = $string_utils:word_start("\"" + argstr);
    return argstr[qs[(length(qs) - length(args)) + 1][1] - 1..length(argstr)];
endif
.

":verbname_match(fullverbname,name) => TRUE iff `name' is a valid name for a verb 
with the given `fullname'";
verblist = (" " + args[1]) + " ";
if (index(verblist, (" " + (name = args[2])) + " ") && (!(index(name, "*") || index(name, 
" "))))
    "Note that if name has a * or a space in it, then it can only match one of the 
* verbnames";
    return 1;
else
    namelen = length(name);
    while (star = index(verblist, "*"))
        vstart = rindex(verblist[1..star], " ") + 1;
        vlast = (vstart + index(verblist[vstart..length(verblist)], " ")) - 2;
        if ((namelen >= (star - vstart)) && ((!(v = strsub(verblist[vstart..vlast], 
"*", ""))) || (index(v, (verblist[vlast] == "*") ? name[1..min(namelen, length(v))] 
| name) == 1)))
            return 1;
        endif
        verblist = verblist[vlast + 1..length(verblist)];
    endwhile
endif
return 0;
.

":show_who_listing(players[,more_players])";
" prints a listing of the indicated players.";
" For players in the first list, idle/connected times are shown if the player is 
logged in, otherwise the last_disconnect_time is shown.  For players in the second 
list, last_disconnect_time is shown, no matter whether the player is logged in.";
idles = itimes = offs = otimes = {};
for p in (args[2])
    if (!valid(p))
        caller:notify(tostr(p, " "));
    elseif (typeof(t = p.last_disconnect_time) == NUM)
        if (!(p in offs))
            offs = {@offs, p};
            otimes = {@otimes, {-t, -t, p}};
        endif
    elseif (is_player(p))
        caller:notify(tostr(p.name, " (", p, ") ", (t == E_PROPNF) ? "is not a $player." 
| "has a garbled .last_disconnect_time."));
    else
        caller:notify(tostr(p.name, " (", p, ") is not a player."));
    endif
endfor
for p in (args[1])
    if (p in offs)
    elseif (!valid(p))
        caller:notify(tostr(p, " "));
    elseif (typeof(i = idle_seconds(p)) != ERR)
        if (!(p in idles))
            idles = {@idles, p};
            itimes = {@itimes, {i, connected_seconds(p), p}};
        endif
    elseif (typeof(t = p.last_disconnect_time) == NUM)
        offs = {@offs, p};
        otimes = {@otimes, {-t, -t, p}};
    elseif (is_player(p))
        caller:notify(tostr(p.name, " (", p, ") not logged in.", (t == E_PROPNF) 
? "  Not a $player." | "  Garbled .last_disconnect_time."));
    else
        caller:notify(tostr(p.name, " (", p, ") is not a player."));
    endif
endfor
if (!(idles || offs))
    return 0;
endif
idles = $list_utils:sort_alist(itimes);
offs = $list_utils:sort_alist(otimes);
"...";
"... calculate widths...";
"...";
headers = {"Player name", @idles ? {"Connected", "Idle time"} | {"Last disconnect 
time", ""}, "Location"};
total_width = caller:linelen() || 79;
max_name = total_width / 4;
name_width = length(headers[1]);
names = locations = {};
for lst in ({@idles, @offs})
    $command_utils:suspend_if_needed(0);
    p = lst[3];
    namestr = tostr(p.name[1..min(max_name, length(p.name))], " (", p, ")");
    name_width = max(length(namestr), name_width);
    names = {@names, namestr};
    if (typeof(wlm = p.location:who_location_msg(p)) != STR)
        wlm = valid(p.location) ? p.location.name | tostr("** Nowhere ** (", p.location, 
")");
    endif
    locations = {@locations, wlm};
endfor
time_width = 3 + (offs ? 12 | length("59 minutes"));
before = {0, w1 = 3 + name_width, w2 = w1 + time_width, w2 + time_width};
"...";
"...print headers...";
"...";
su = $string_utils;
tell1 = headers[1];
tell2 = su:space(tell1, "-");
for j in [2..4]
    tell1 = su:left(tell1, before[j]) + headers[j];
    tell2 = su:left(tell2, before[j]) + su:space(headers[j], "-");
endfor
caller:notify(tell1[1..min(length(tell1), total_width)]);
caller:notify(tell2[1..min(length(tell2), total_width)]);
"...";
"...print lines...";
"...";
active = 0;
for i in [1..total = (ilen = length(idles)) + length(offs)]
    if (i <= ilen)
        lst = idles[i];
        if (lst[1] < (5 * 60))
            active = active + 1;
        endif
        l = {names[i], su:from_seconds(lst[2]), su:from_seconds(lst[1]), locations[i]};
    else
        lct = offs[i - ilen][3].last_connect_time;
        ldt = offs[i - ilen][3].last_disconnect_time;
        ctime = caller:ctime(ldt) || ctime(ldt);
        l = {names[i], (lct <= time()) ? ctime | "Never", "", locations[i]};
        if ((i == (ilen + 1)) && idles)
            caller:notify(su:space(before[2]) + "------- Disconnected -------");
        endif
    endif
    tell1 = l[1];
    for j in [2..4]
        tell1 = su:left(tell1, before[j]) + l[j];
    endfor
    caller:notify(tell1[1..min(length(tell1), total_width)]);
    if ($command_utils:running_out_of_time())
        now = time();
        suspend(0);
        if ((time() - now) > 10)
            caller:notify(tostr("Plus ", total - i, " other players (", total, " 
total; out of time and lag is high)."));
            return;
        endif
    endif
endfor
"...";
"...epilogue...";
"...";
caller:notify("");
if (total == 1)
    active_str = ", who has" + ((active == 1) ? "" | " not");
else
    if (active == total)
        active_str = (active == 2) ? "s, both" | "s, all";
    elseif (active == 0)
        active_str = "s, none";
    else
        active_str = tostr("s, ", active);
    endif
    active_str = tostr(active_str, " of whom ha", (active == 1) ? "s" | "ve");
endif
caller:notify(tostr("Total: ", total, " player", active_str, " been active recently."));
return total;
.

":_egrep_verb_code(regexp,object,verbname) => list of lines number";
"  returns list of all lines matching regexp in object:verbname code";
set_task_perms(caller_perms());
pattern = args[1];
lines = {};
for line in (vc = verb_code(@args[2..3], 1, 0))
    if (match(line, pattern))
        lines = {@lines, line};
    endif
endfor
return lines;
.

":_grep_verb_code_all(pattern,object,verbname) => list of lines";
"  returns list of lines on which pattern occurs in code for object:verbname";
set_task_perms(caller_perms());
pattern = args[1];
lines = {};
for line in (vc = verb_code(@args[2..3]))
    if (index(line, pattern))
        lines = {@lines, line};
    endif
endfor
return lines;
.

":verb_usage([object,verbname]) => usage string at beginning of verb code, if any";
"default is the calling verb";
set_task_perms(caller_perms());
if (args)
    object = args[1];
    vname = args[2];
else
    c = callers()[1];
    object = c[4];
    vname = c[2];
endif
if (typeof(code = verb_code(object, vname)) == ERR)
    return code;
else
    doc = {};
    for line in (code)
        if (match(line, "^\"%([^\\\"]%|\\.%)*\";$"))
            "... now that we're sure `line' is just a string, eval() is safe...";
            e = $no_one:eval(line)[2];
            if (subs = match(e, "^%(Usage: +%)%([^ ]+%)%(.*$%)"))
                "Server is broken, hence the next three lines:";
                if (subs[3][3][1] > subs[3][3][2])
                    subs[3][3] = {0, -1};
                endif
                indent = ("^%(" + $string_utils:space(length(substitute("%1", subs)))) 
+ " *%)%([^ ]+%)%(.*$%)";
                docverb = substitute("%2", subs);
                if (match(vname, "^[0-9]+$"))
                    vname = docverb;
                endif
                doc = {@doc, (substitute("%1", subs) + vname) + substitute("%3", 
subs)};
            elseif (subs = match(e, indent))
                if (substitute("%2", subs) == docverb)
                    doc = {@doc, (substitute("%1", subs) + vname) + substitute("%3", 
subs)};
                else
                    doc = {@doc, e};
                endif
            elseif (indent)
                return doc;
            endif
        else
            return doc;
        endif
    endfor
    return doc;
endif
.