Generic Option Package #62

Parent #1Owner #29Flags read, fertileSource hellcore/hellcore.db

Aliases: Generic Option Package

12 verbs · 14 properties · 5 children

Verbs

VerbSpecFlagsDefinerLines
getthis none thisrxd#6212
setthis none thisrxd#6272
parsethis none thisrxd#6261
_namethis none thisrxd#6214
add_namethis none thisrxd#6238
remove_namethis none thisrxd#6213
showthis none thisrxd#6250
actualthis none thisrxd#625
istypethis none thisrxd#6213
islistofthis none thisrxd#628
desc_typethis none thisrxd#6216
parsechoicethis none thisrxd#6226

Properties

PropertyDefinerFlagsOwnerValue
names#62r#29{}
_namelist#62r#29"!"
extras#62r#29{}
namewidth#62rc#2915
aliases#1rc#29{"Generic Option Package"}
description#1rc#29"an option package in need of a description. See `help $generic_option'..."
object_size#1r#29{12957, 1298433815}
hidden_verbs#1rc#29<clear>
phelp_msg#1rc#29<clear>
weight#1rc#29<clear>
owner_verbs#1rc#29<clear>
plural_name#1rc#29<clear>
client_image#1rc#29<clear>
listening#1rc#29<clear>

Ancestry

Ancestors (nearest first): #1 root

Children: #59 Mail Options, #60 Edit Options, #61 Display Options, #70 Programmer Options, #71 Builder Options

Call graph

calls n62_0 #62:get n47_17 #47:assoc n62_0->n47_17 n62_1 #62:set n62_1->n47_17 n45_3 #45:has_callable_verb n62_1->n45_3 n45_0 #45:has_property n62_1->n45_0 n62_8 #62:istype n62_1->n62_8 n20_15 #20:capitalize n62_1->n20_15 n62_10 #62:desc_type n62_1->n62_10 n20_6 #20:english_list n62_1->n20_6 n47_16 #47:slice n62_1->n47_16 n62_7 #62:actual n62_1->n62_7 n47_18 #47:iassoc n62_1->n47_18 n62_9 #62:islistof n62_8->n62_9 n62_10->n62_10 n62_10->n20_6 n62_2 #62:parse n62_2->n45_3 n62_2->n45_0 n20_5 #20:from_list n62_2->n20_5 n62_3 #62:_name n62_2->n62_3 n62_11 #62:parsechoice n62_2->n62_11 n62_11->n20_6 n62_11->n47_16 n62_4 #62:add_name n42_0 #42:controls n62_4->n42_0 n62_5 #62:remove_name n62_5->n42_0 n62_6 #62:show n62_6->n62_0 n62_6->n47_17 n62_6->n45_3 n62_6->n45_0 n62_6->n62_6 n20_1 #20:left n62_6->n20_1 n20_0 #20:space n62_6->n20_0 n62_9->n62_8

Source

get

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

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

set

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

none

Source

1":set(optionlist,oname,value) => revised optionlist or string error message.";
2"oname must be the full name of an option in .names or .extras.";
3"Note that values must not be of type ERR.  ";
4"FALSE (0, blank string, or empty list) is always a legal value.";
5"If a verb :check_foo is defined on this, it will be used to typecheck any";
6"non-false or object-type value supplied as a new value for option `foo'.";
7"";
8"   :check_foo(value) => string error message or {value to use}";
9"";
10"If instead there is a property .check_foo, that will give either the expected ";
11"type or a list of allowed types.";
12"Otherwise, the option is taken to be a boolean flag and all non-false, ";
13"non-object values map to 1.";
14"";
15{options, oname, value} = args;
16if (!((oname in this.names) || (oname in this.extras)))
17return "Unknown option:  " + oname;
18elseif (typeof(value) == ERR)
19"... no option should have an error value...";
20return "Error value";
21elseif ((!value) && (typeof(value) != OBJ))
22"... always accept FALSE (0, blankstring, emptylist)...";
23elseif ($object_utils:has_callable_verb(this, check = "check_" + oname))
24"... a :check_foo verb exists; use it to typecheck the value...";
25if (typeof(c = this:(check)(value)) == STR)
26return c;
27endif
28value = c[1];
29elseif ($object_utils:has_property(this, tprop = "type_" + oname))
30"... a .type_foo property exists...";
31"... property value should be a type or list of types...";
32if (!this:istype(value, t = this.(tprop)))
33return $string_utils:capitalize(this:desc_type(t) + " value expected.");
34endif
35elseif ($object_utils:has_property(this, cprop = "choices_" + oname))
36"... a .choices_foo property exists...";
37"... property value should be a list of {value,docstring} pairs...";
38if (!$list_utils:assoc(value, c = this.(cprop)))
39return tostr("Allowed values: ", $string_utils:english_list($list_utils:slice(c, 1), "(??)", " or "));
40endif
41else
42"... value is considered to be boolean...";
43if (!value)
44"... must be an object.  oops.";
45return tostr("Non-object value expected.");
46endif
47value = 1;
48endif
49"... We now have oname and a value.  However, if oname is one of the extras,";
50"... then we need to call :actual to see what it really means.";
51if (oname in this.names)
52nvlist = {{oname, value}};
53elseif ((typeof(nvlist = this:actual(oname, value)) != LIST) || (!nvlist))
54return nvlist || "Not implemented.";
55endif
56"... :actual returns a list of pairs...";
57for nv in (nvlist)
58{oname, value} = nv;
59if (i = (oname in options) || $list_utils:iassoc(oname, options))
60if ((!value) && (typeof(value) != OBJ))
61"value == 0, blank string, empty list";
62options[i..i] = {};
63elseif (value == 1)
64options[i] = oname;
65else
66options[i] = {oname, value};
67endif
68elseif (value || (typeof(value) == OBJ))
69options[1..0] = {(value == 1) ? oname | {oname, value}};
70endif
71endfor
72return options;

parse

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

none

Source

1":parse(args[,...]) => {oname [,value]} or string error message";
2"additional arguments are fed straight through to :parse_* routines.";
3" <option> <value>     => {option, value}";
4" <option>=<value>     => {option, value}";
5" <option> is <value>  => {option, value}";
6" +<option>            => {option, 1}";
7" -<option>            => {option, 0}";
8" !<option>            => {option, 0}";
9" <option>             => {option}";
10if (!(words = args[1]))
11return "";
12endif
13option = words[1];
14words[1..1] = {};
15if (flag = option && index("-+!", option[1]))
16option[1..1] = "";
17endif
18if (i = index(option, "="))
19rawval = option[i + 1..$];
20option = option[1..i - 1];
21if (i == 1)
22"... =bar ...";
23return "Blank option name?";
24elseif (flag)
25"... +foo=bar";
26return "Don't give a value if you use +, -, or !";
27elseif (words)
28"... foo=bar junk";
29return $string_utils:from_list(words, " ") + "??";
30endif
31elseif (!option)
32return "Blank option name?";
33elseif (flag)
34if (words)
35"... +foo junk";
36return "Don't give a value if you use +, -, or !";
37endif
38rawval = (flag - 1) % 2;
39else
40words && ((words[1] == "is") && (words[1..1] = {}));
41rawval = words;
42endif
43"... do we know about this option?...";
44if (!(oname = this:_name(strsub(option, "-", "_"))))
45return tostr((oname == $failed_match) ? "Unknown" | "Ambiguous", " option:  ", option);
46endif
47"... determine new value...";
48if (!rawval)
49"... `@option foo is' or `@option foo=' ...";
50return (rawval == {}) ? {oname} | {oname, 0};
51elseif ($object_utils:has_callable_verb(this, pverb = "parse_" + oname))
52return this:(pverb)(oname, rawval, args[2..$]);
53elseif ($object_utils:has_property(this, cprop = "choices_" + oname))
54return this:parsechoice(oname, rawval, this.(cprop));
55elseif (rawval in {0, "0", {"0"}})
56return {oname, 0};
57elseif (rawval in {1, "1", {"1"}})
58return {oname, 1};
59else
60return tostr("Option is a flag, use `+", option, "' or `-", option, "' (or `!", option, "')");
61endif

_name

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":_name(string) => full option name corresponding to string ";
2"               => $failed_match or $ambiguous_match as appropriate.";
3if (((string = args[1]) in this.names) || (string in this.extras))
4return string;
5endif
6char = (namestr = this._namelist)[1];
7if (!(i = index(namestr, char + string)))
8return $failed_match;
9elseif (i != rindex(namestr, char + string))
10return $ambiguous_match;
11else
12j = index(namestr[i + 1..$], char);
13return namestr[i + 1..(i + j) - 1];
14endif

add_name

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

none

Source

1":add_name(name[,isextra]) adds name to the list of options recognized.";
2"name must be a nonempty string and must not contain spaces, -, +, !, or =.";
3"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";
4{name, ?isextra = 0} = args;
5if (!$perm_utils:controls(caller_perms(), this))
6return E_PERM;
7elseif ((!name) || match(name, "[-!+= ]"))
8"...name is blank or contains a forbidden character";
9return E_INVARG;
10elseif (name in this.names)
11"...name is already in option list";
12if (isextra)
13this.names = setremove(this.names, name);
14this.extras = setadd(this.extras, name);
15return 1;
16else
17return 0;
18endif
19elseif (name in this.extras)
20if (isextra)
21return 0;
22else
23this.names = setadd(this.names, name);
24this.extras = setremove(this.extras, name);
25return 1;
26endif
27else
28char = this._namelist[1];
29if (isextra)
30this.extras = setadd(this.extras, name);
31else
32this.names = setadd(this.names, name);
33endif
34if (!index(this._namelist, (char + name) + char))
35this._namelist = tostr(this._namelist, name, char);
36endif
37return 1;
38endif

remove_name

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":remove_name(name) removes name from the list of options recognized.";
2if (!$perm_utils:controls(caller_perms(), this))
3return E_PERM;
4elseif (!(((name = args[1]) in this.names) || (name in this.extras)))
5"...hmm... already gone...";
6return 0;
7else
8char = this._namelist[1];
9this._namelist = strsub(this._namelist, (char + name) + char, char);
10this.names = setremove(this.names, name);
11this.extras = setremove(this.extras, name);
12return 1;
13endif

show

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":show(options,name or list of names)";
2" => text describing current value of option and what it means";
3name = args[2];
4if (typeof(name) == LIST)
5text = {};
6for n in (name)
7text = {@text, @this:show(@listset(args, n, 2))};
8endfor
9return text;
10elseif (!((name in this.names) || (name in this.extras)))
11return {"Unknown option:  " + name};
12elseif ($object_utils:has_callable_verb(this, sverb = "show_" + name))
13r = this:(sverb)(@args);
14value = r[1];
15desc = r[2];
16elseif ($object_utils:has_property(this, sverb) && ((value = this:get(args[1], name)) in {0, 1}))
17desc = this.(sverb)[value + 1];
18if (typeof(desc) == STR)
19desc = {desc};
20endif
21elseif ($object_utils:has_property(this, cprop = "choices_" + name))
22if (!(value = this:get(args[1], name)))
23desc = this.(cprop)[1][2];
24elseif (!(a = $list_utils:assoc(value, this.(cprop))))
25return {(name + " has unexpected value ") + toliteral(value)};
26else
27desc = a[2];
28endif
29elseif (name in this.extras)
30return {name + " not documented (complain)"};
31else
32value = this:get(args[1], name);
33desc = {"not documented (complain)"};
34if (typeof(value) in {LIST, STR})
35desc[1..0] = toliteral(value);
36value = "";
37endif
38endif
39if (value in {0, 1})
40which = "-+"[value + 1] + name;
41elseif ((typeof(value) in {OBJ, STR, INT}) && (value != ""))
42which = tostr(" ", name, "=", value);
43else
44which = " " + name;
45endif
46show = {$string_utils:left(which + "  ", this.namewidth) + desc[1]};
47for i in [2..length(desc)]
48show = {@show, $string_utils:space(this.namewidth) + desc[i]};
49endfor
50return show;

actual

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

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

istype

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":istype(value,types) => whether value is one of the given types";
2if ((vtype = typeof(value = args[1])) in (types = args[2]))
3return 1;
4elseif (vtype != LIST)
5return 0;
6else
7for t in (types)
8if ((typeof(t) == LIST) && this:islistof(value, t))
9return 1;
10endif
11endfor
12endif
13return 0;

islistof

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

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

desc_type

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":desc_type(types) => string description of types";
2nlist = {};
3for t in (types = args[1])
4if (typeof(t) == LIST)
5if (length(t) > 1)
6nlist = {@nlist, tostr("(", this:desc_type(t), ")-list")};
7else
8nlist = {@nlist, tostr(this:desc_type(t), "-list")};
9endif
10elseif (t in {INT, OBJ, STR, LIST})
11nlist = {@nlist, {"number", "object", "string", "?", "list"}[t + 1]};
12else
13return "Bad type list";
14endif
15endfor
16return $string_utils:english_list(nlist, "nothing", " or ");

parsechoice

Spec this none thisFlags rxdOwner #29Definer #62

Referenced by

Source

1":parsechoice(oname,rawval,assoclist)";
2which = {};
3oname = args[1];
4rawval = args[2];
5choices = $list_utils:slice(args[3], 1);
6errmsg = tostr("Allowed values for this flag: ", $string_utils:english_list(choices, "(??)", " or "));
7if (typeof(rawval) == LIST)
8if (length(rawval) > 1)
9return errmsg;
10endif
11rawval = rawval[1];
12elseif (typeof(rawval) != STR)
13return errmsg;
14endif
15for c in (choices)
16if (index(c, rawval) == 1)
17which = {@which, c};
18endif
19endfor
20if (!which)
21return errmsg;
22elseif (length(which) > 1)
23return tostr(rawval, " is ambiguous.");
24else
25return {oname, which[1]};
26endif