Generic Help Database (#32)

"WIZARDLY";
if (args)
    "...check for an exact match first...";
    search = args[1];
    if (property_info(parent(this), search))
        if (property_info(this, " " + search))
            return {search};
        endif
    elseif (property_info(this, search))
        return {search};
    endif
    "...search for partial matches, allowing for";
    "...confusion between topics that do and don't start with @, and";
    ".. confusion between - and _ characters.";
    props = properties(this);
    topics = {};
    if (search[1] == "@")
        search = search[2..length(search)];
    endif
    search = strsub(search, "-", "_");
    if (!search)
        "...don't try searching for partial matches if the string is empty or @";
        "...we'd get *everything*...";
        return {};
    endif
    for prop in (props)
        if (((i = index(strsub(prop, "-", "_"), search)) == 1) || ((i == 2) && index(" 
@", prop[1])))
            topics = {@topics, (prop[1] == " ") ? prop[2..length(prop)] | prop};
        endif
    endfor
    return topics;
else
    "...return list of all topics...";
    props = setremove(properties(this), "");
    for p in ($object_utils:all_properties(parent(this)))
        if (i = (" " + p) in props)
            props = {p, @listdelete(props, i)};
        endif
    endfor
    return props;
endif
.

"WIZARDLY";
topic = args[1];
dblist = {@args, {}}[2];
text = this.(topic) || this.(" " + topic);
if (typeof(text) == LIST)
    if (text && (text[1] == (("*" + (vb = strsub(text[1], "*", ""))) + "*")))
        text = this:(vb)(listdelete(text, 1), dblist);
    endif
endif
return text;
.

":sort_topics(list_of_topics) -- sorts the given list of strings, assuming that they're 
help-system topic names";
buckets = "abcdefghijklmnopqrstuvwxyz";
keys = names = $list_utils:make(length(buckets) + 1, {});
for name in (setremove(args[1], ""))
    key = index(".@", name[1]) ? name[2..length(name)] + " " | name;
    k = index(buckets, key[1]) + 1;
    bucket = keys[k];
    i = $list_utils:find_insert(bucket, key);
    keys[k] = listinsert(bucket, key, i);
    names[k] = listinsert(names[k], name, i);
    $command_utils:suspend_if_needed(0);
endfor
return $list_utils:append(@names);
.

":columnize(@list_of_strings) -- prints the given list of strings in 4 columns.";
sorted = {@args, "", "", ""};
n = length(sorted) / 4;
su = $string_utils;
index = {};
for i in [1..n]
    index = {@index, tostr(su:left(sorted[i], 20), su:left(sorted[i + n], 20), su:left(sorted[i 
+ (2 * n)], 20), sorted[i + (3 * n)])};
    $command_utils:suspend_if_needed(0);
endfor
return index;
.

"{\"*forward*\", topic, @rest}  => text for topic from this help db.";
"{\"*pass*\",    topic, @rest}  => text for topic from next help db.";
"In both cases the text of @rest is appended.  ";
"@rest may in turn begin with a **";
text = args[1];
dblist = {@args, {}}[2];
if (verb == "forward")
    first = this:get_topic(text[1], dblist);
elseif ((result = $code_utils:help_db_search(text[1], dblist)) && ((db = result[1]) 
!= $ambiguous_match))
    first = db:get_topic(result[2], dblist[(db in dblist) + 1..length(dblist)]);
else
    first = {};
endif
if (2 <= (len = length(text)))
    if (text[2] == (("*" + (vb = strsub(text[2], "*", ""))) + "*"))
        return {@first, @this:(vb)(text[3..len], dblist)};
    else
        return {@first, @text[2..len]};
    endif
else
    return first;
endif
.

"{\"*subst*\", @text} => text with the following substitutions:";
"  \"...%[expr]....\" => \"...\"+value of expr (assumed to be a string)+\"....\"";
"  \"%;expr\"         => @(value of expr (assumed to be a list of strings))";
newlines = {};
for old in (args[1])
    new = "";
    bomb = 0;
    while ((prcnt = index(old, "%")) && (prcnt < length(old)))
        new = new + old[1..prcnt - 1];
        code = old[prcnt + 1];
        old = old[prcnt + 2..length(old)];
        if (code == "[")
            prog = "";
            while ((b = index(old + "]", "]")) > (p = index(old + "%", "%")))
                prog = (prog + old[1..p - 1]) + old[p + 1];
                old = old[p + 2..length(old)];
            endwhile
            prog = prog + old[1..b - 1];
            old = old[b + 1..length(old)];
            value = $no_one:eval_d(prog);
            if (value[1])
                new = tostr(new, value[2]);
            else
                new = tostr(new, $string_utils:print(value[2]));
                bomb = 1;
            endif
        elseif ((code != ";") || new)
            new = (new + "%") + code;
        else
            value = $no_one:eval_d(old);
            if (value[1] && (typeof(r = value[2]) == LIST))
                newlines = {@newlines, @r[1..length(r) - 1]};
                new = tostr(r[length(r)]);
            else
                new = tostr(new, $string_utils:print(value[2]));
                bomb = 1;
            endif
            old = "";
        endif
    endwhile
    if (bomb)
        newlines = {@newlines, new + old, tostr("@@@ Helpfile alert:  Previous line 
is messed up; notify ", this.owner.wizard ? "" | tostr(this.owner.name, " (", this.owner, 
") or "), "a wizard. @@@")};
    else
        newlines = {@newlines, new + old};
    endif
endfor
return newlines;
.

"{\"*index*\" [, title]}";
"This produces a columnated list of topics in this help db, headed by title.";
$command_utils:suspend_if_needed(0);
title = args[1] ? args[1][1] | tostr(this.name, " (", this, ")");
su = $string_utils;
return {"", title, su:from_list($list_utils:map_arg(su, "space", su:explode(title), 
"-"), " "), @this:columnize(@this:sort_topics(this:find_topics()))};
.

pass(@args);
if ($perm_utils:controls(caller_perms(), this))
    this.r = 1;
    this.f = 0;
endif
.

"{\"*verbdoc*\", \"object\", \"verbname\"}  use documentation for this verb";
set_task_perms(this.owner);
if (!valid(object = $string_utils:match_object(args[1][1], player.location)))
    return E_INVARG;
elseif (!(hv = $object_utils:has_verb(object, vname = args[1][2])))
    return E_VERBNF;
else
    return $code_utils:verb_documentation(hv[1], vname);
endif
.

if (typeof(text = this.(fulltopic = args[1])) == ERR)
    return text;
else
    return {tostr(";;", $code_utils:corify_object(this), ".(", $string_utils:print(fulltopic), 
") = $command_utils:read_lines()"), @$command_utils:dump_lines(text)};
endif
.