Generic Option Package (#67)

":get(options,name) => returns the value of the option specified by name";
"i.e., if {name,value} is present in options, return value";
"      if name is present, return 1";
"      otherwise return 0";
if ((name = args[2]) in (options = args[1]))
    return 1;
elseif (a = $list_utils:assoc(name, options))
    return a[2];
else
    return 0;
endif
.

":set(optionlist,oname,value) => revised optionlist or string error message.";
"oname must be the full name of an option in .names or .extras.";
"Note that values must not be of type ERR.  ";
"FALSE (0, blank string, or empty list) is always a legal value.";
"If a verb :check_foo is defined on this, it will be used to typecheck any";
"non-false or object-type value supplied as a new value for option `foo'.";
"";
"   :check_foo(value) => string error message or {value to use}";
"";
"If instead there is a property .check_foo, that will give either the expected ";
"type or a list of allowed types.";
"Otherwise, the option is taken to be a boolean flag and all non-false, ";
"non-object values map to 1.";
"";
options = args[1];
if (!(((oname = args[2]) in this.names) || (oname in this.extras)))
    return "Unknown option:  " + oname;
elseif (typeof(value = args[3]) == ERR)
    "... no option should have an error value...";
    return "Error value";
elseif ((!value) && (typeof(value) != OBJ))
    "... always accept FALSE (0, blankstring, emptylist)...";
elseif ($object_utils:has_callable_verb(this, check = "check_" + oname))
    "... a :check_foo verb exists; use it to typecheck the value...";
    if (typeof(c = this:(check)(value)) == STR)
        return c;
    endif
    value = c[1];
elseif ($object_utils:has_property(this, tprop = "type_" + oname))
    "... a .type_foo property exists...";
    "... property value should be a type or list of types...";
    if (!this:istype(value, t = this.(tprop)))
        return $string_utils:capitalize(this:desc_type(t) + " value expected.");
    endif
elseif ($object_utils:has_property(this, cprop = "choices_" + oname))
    "... a .choices_foo property exists...";
    "... property value should be a list of {value,docstring} pairs...";
    if (!$list_utils:assoc(value, c = this.(cprop)))
        return tostr("Allowed values: ", $string_utils:english_list($list_utils:slice(c, 
1), "(??)", " or "));
    endif
else
    "... value is considered to be boolean...";
    if (!value)
        "... must be an object.  oops.";
        return tostr("Non-object value expected.");
    endif
    value = 1;
endif
"... We now have oname and a value.  However, if oname is one of the extras,";
"... then we need to call :actual to see what it really means.";
if (oname in this.names)
    nvlist = {{oname, value}};
elseif ((typeof(nvlist = this:actual(oname, value)) != LIST) || (!nvlist))
    return nvlist || "Not implemented.";
endif
"... :actual returns a list of pairs...";
for nv in (nvlist)
    oname = nv[1];
    value = nv[2];
    if (i = (oname in options) || $list_utils:iassoc(oname, options))
        if ((!value) && (typeof(value) != OBJ))
            "value == 0, blank string, empty list";
            options[i..i] = {};
        elseif (value == 1)
            options[i] = oname;
        else
            options[i] = {oname, value};
        endif
    elseif (value || (typeof(value) == OBJ))
        options[1..0] = {(value == 1) ? oname | {oname, value}};
    endif
endfor
return options;
.

":parse(args[,...]) => {oname [,value]} or string error message";
"additional arguments are fed straight through to :parse_* routines.";
"       => {option, value}";
" =     => {option, value}";
"  is   => {option, value}";
" +            => {option, 1}";
" -            => {option, 0}";
" !            => {option, 0}";
"              => {option}";
if (!(words = args[1]))
    return "";
endif
option = words[1];
words[1..1] = {};
if (flag = option && index("-+!", option[1]))
    option[1..1] = "";
endif
if (i = index(option, "="))
    rawval = option[i + 1..length(option)];
    option = option[1..i - 1];
    if (i == 1)
        "... =bar ...";
        return "Blank option name?";
    elseif (flag)
        "... +foo=bar";
        return "Don't give a value if you use +, -, or !";
    elseif (words)
        "... foo=bar junk";
        return $string_utils:from_list(words, " ") + "??";
    endif
elseif (!option)
    return "Blank option name?";
elseif (flag)
    if (words)
        "... +foo junk";
        return "Don't give a value if you use +, -, or !";
    endif
    rawval = (flag - 1) % 2;
else
    words && ((words[1] == "is") && (words[1..1] = {}));
    rawval = words;
endif
"... do we know about this option?...";
if (!(oname = this:_name(strsub(option, "-", "_"))))
    return tostr((oname == $failed_match) ? "Unknown" | "Ambiguous", " option: ", 
option);
endif
"... determine new value...";
if (!rawval)
    "... `@option foo is' or `@option foo=' ...";
    return (rawval == {}) ? {oname} | {oname, 0};
elseif ($object_utils:has_callable_verb(this, pverb = "parse_" + oname))
    return this:(pverb)(oname, rawval, args[2..length(args)]);
elseif ($object_utils:has_property(this, cprop = "choices_" + oname))
    return this:parsechoice(oname, rawval, this.(cprop));
elseif (rawval in {0, "0", {"0"}})
    return {oname, 0};
elseif (rawval in {1, "1", {"1"}})
    return {oname, 1};
else
    return tostr("Option is a flag, use `+", option, "' or `-", option, "' (or `!", 
option, "')");
endif
.

":_name(string) => full option name corresponding to string ";
"               => $failed_match or $ambiguous_match as appropriate.";
if (((string = args[1]) in this.names) || (string in this.extras))
    return string;
endif
char = (namestr = this._namelist)[1];
if (!(i = index(namestr, char + string)))
    return $failed_match;
elseif (i != rindex(namestr, char + string))
    return $ambiguous_match;
else
    j = index(namestr[i + 1..length(namestr)], char);
    return namestr[i + 1..(i + j) - 1];
endif
.

":add_name(name[,isextra]) adds name to the list of options recognized.";
"name must be a nonempty string and must not contain spaces, -, +, !, or =.";
"isextra true means that name isn't an actual option (recognized by :get) but merely 
a name that the option setting command should recognize to set a particular combination 
of options.  Actual options go in .names; others go in .extras";
name = args[1];
isextra = {@args, 0}[2];
if (!$perm_utils:controls(caller_perms(), this))
    return E_PERM;
elseif ((!name) || match(name, "[-!+= ]"))
    "...name is blank or contains a forbidden character";
    return E_INVARG;
elseif (name in this.names)
    "...name is already in option list";
    if (isextra)
        this.names = setremove(this.names, name);
        this.extras = setadd(this.extras, name);
        return 1;
    else
        return 0;
    endif
elseif (name in this.extras)
    if (isextra)
        return 0;
    else
        this.names = setadd(this.names, name);
        this.extras = setremove(this.extras, name);
        return 1;
    endif
else
    char = this._namelist[1];
    if (isextra)
        this.extras = setadd(this.extras, name);
    else
        this.names = setadd(this.names, name);
    endif
    if (!index(this._namelist, (char + name) + char))
        this._namelist = tostr(this._namelist, name, char);
    endif
    return 1;
endif
.

":remove_name(name) removes name from the list of options recognized.";
if (!$perm_utils:controls(caller_perms(), this))
    return E_PERM;
elseif (!(((name = args[1]) in this.names) || (name in this.extras)))
    "...hmm... already gone...";
    return 0;
else
    char = this._namelist[1];
    this._namelist = strsub(this._namelist, (char + name) + char, char);
    this.names = setremove(this.names, name);
    this.extras = setremove(this.extras, name);
    return 1;
endif
.

":show(options,name or list of names)";
" => text describing current value of option and what it means";
name = args[2];
if (typeof(name) == LIST)
    text = {};
    for n in (name)
        text = {@text, @this:show(@listset(args, n, 2))};
    endfor
    return text;
elseif (!((name in this.names) || (name in this.extras)))
    return {"Unknown option:  " + name};
elseif ($object_utils:has_callable_verb(this, sverb = "show_" + name))
    r = this:(sverb)(@args);
    value = r[1];
    desc = r[2];
elseif ($object_utils:has_property(this, sverb) && ((value = this:get(args[1], name)) 
in {0, 1}))
    desc = this.(sverb)[value + 1];
    if (typeof(desc) == STR)
        desc = {desc};
    endif
elseif ($object_utils:has_property(this, cprop = "choices_" + name))
    if (!(value = this:get(args[1], name)))
        desc = this.(cprop)[1][2];
    elseif (!(a = $list_utils:assoc(value, this.(cprop))))
        return {(name + " has unexpected value ") + $string_utils:print(value)};
    else
        desc = a[2];
    endif
elseif (name in this.extras)
    return {name + " not documented (complain)"};
else
    value = this:get(args[1], name);
    desc = {"not documented (complain)"};
    if (typeof(value) in {LIST, STR})
        desc[1..0] = $string_utils:print(value);
        value = "";
    endif
endif
if (value in {0, 1})
    which = "-+"[value + 1] + name;
elseif ((typeof(value) in {OBJ, STR, NUM}) && (value != ""))
    which = tostr(" ", name, "=", value);
else
    which = " " + name;
endif
show = {$string_utils:left(which + "  ", this.namewidth) + desc[1]};
for i in [2..length(desc)]
    show = {@show, $string_utils:space(this.namewidth) + desc[i]};
endfor
return show;
.

":actual(,) => list of {,} pairs or string errormsg";
" corresponding to what setting option  to  actually means";
" e.g., :actual(\"unfoo\",1) => {{\"foo\",0}}";
" e.g., :actual(\"g7mode\",1) => {{\"splat\",37},{\"baz\",#3}}";
return "Not implemented.";
.

":istype(value,types) => whether value is one of the given types";
if ((vtype = typeof(value = args[1])) in (types = args[2]))
    return 1;
elseif (vtype != LIST)
    return 0;
else
    for t in (types)
        if ((typeof(t) == LIST) && this:islistof(value, t))
            return 1;
        endif
    endfor
endif
return 0;
.

":islistof(value,types) => whether value (a list) has each element being one of the 
given types";
types = args[2];
for v in (value = args[1])
    if (!this:istype(v, types))
        return 0;
    endif
endfor
return 1;
.

":desc_type(types) => string description of types";
nlist = {};
for t in (types = args[1])
    if (typeof(t) == LIST)
        if (length(t) > 1)
            nlist = {@nlist, tostr("(", this:desc_type(t), ")-list")};
        else
            nlist = {@nlist, tostr(this:desc_type(t), "-list")};
        endif
    elseif (t in {NUM, OBJ, STR, LIST})
        nlist = {@nlist, {"number", "object", "string", "?", "list"}[t + 1]};
    else
        return "Bad type list";
    endif
endfor
return $string_utils:english_list(nlist, "nothing", " or ");
.

":parsechoice(oname,rawval,assoclist)";
which = {};
oname = args[1];
rawval = args[2];
choices = $list_utils:slice(args[3], 1);
errmsg = tostr("Allowed values for this flag: ", $string_utils:english_list(choices, 
"(??)", " or "));
if (typeof(rawval) == LIST)
    if (length(rawval) > 1)
        return errmsg;
    endif
    rawval = rawval[1];
elseif (typeof(rawval) != STR)
    return errmsg;
endif
for c in (choices)
    if (index(c, rawval) == 1)
        which = {@which, c};
    endif
endfor
if (!which)
    return errmsg;
elseif (length(which) > 1)
    return tostr(rawval, " is ambiguous.");
else
    return {oname, which[1]};
endif
.