## global-control-index.pkg
# Compiled by:
# src/lib/global-controls/global-controls.libstipulate
package cf = global_control_forms; # global_control_forms is from src/lib/global-controls/global-control-forms.pkg package cst = global_control_set; # global_control_set is from src/lib/global-controls/global-control-set.pkg package ctl = global_control; # global_control is from src/lib/global-controls/global-control.pkg package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package qht = quickstring_hashtable; # quickstring_hashtable is from src/lib/src/quickstring-hashtable.pkg package qs = quickstring__premicrothread; # quickstring__premicrothread is from src/lib/src/quickstring--premicrothread.pkg package wnx = winix__premicrothread; # winix__premicrothread is from src/lib/std/winix--premicrothread.pkgherein
package global_control_index
: (weak) Global_Control_Index # Global_Control_Index is from src/lib/global-controls/global-control-index.api {
Control_Info
=
{ dictionary_name: Null_Or( String ) };
Global_Control_Set
=
cf::Global_Control_Set( String, Control_Info );
Global_Control_Index
=
CONTROL_INDEX
{
help: String, # Registry's description.
control_set: Global_Control_Set, # Controls in this registry.
q_regs: qht::Hashtable( Subindex ), # Qualified sub-registries.
u_regs: Ref( List( Subindex ) ) # Unqualified sub-registries.
}
also
Subindex
=
SUB_REGISTRY
{
prefix: Null_Or( String ), # The key for qualified registries.
menu_slot: ctl::Menu_Slot, # Positions control within the menu hierarchy.
obscurity: Int, # Registry's detail level; higher means more obscure.
reg: Global_Control_Index
};
fun make { help }
=
CONTROL_INDEX
{
help,
control_set => cst::make_control_set (),
q_regs => qht::make_hashtable { size_hint => 8, not_found_exception => DIE "qualified registries" },
u_regs => REF []
};
# Register a control:
#
fun note_control (CONTROL_INDEX { control_set, ... } ) { control, dictionary_name }
=
cst::set (control_set, control, { dictionary_name } );
# Register a set of controls:
#
fun note_control_set (CONTROL_INDEX { control_set, ... } ) { control_set=>cs, make_dictionary_name }
=
{ fun insert { control, info }
=
cst::set (control_set, control, { dictionary_name=>make_dictionary_name (ctl::name control) } );
cst::apply insert cs;
};
# Nest a registry inside another registry:
#
fun note_subindex (CONTROL_INDEX { u_regs, q_regs, ... } ) { prefix, menu_slot, obscurity, reg }
=
{ subregistry
=
SUB_REGISTRY
{
prefix,
menu_slot,
obscurity,
reg
};
case prefix
#
NULL => u_regs := subregistry ! *u_regs;
#
THE qual => qht::set q_regs (qs::from_string qual, subregistry);
esac;
};
fun find_control reg (path: List( String ))
=
find (reg, list::map qs::from_string path)
where
fun find (_, [])
=>
NULL;
find (CONTROL_INDEX { control_set, u_regs, ... }, [name])
=>
case (cst::find (control_set, name))
THE { control, ... } => THE control;
NULL => find_in_list (*u_regs, [name]);
esac;
find (CONTROL_INDEX { q_regs, u_regs, ... }, prefix ! r)
=>
case (qht::find q_regs prefix)
NULL
=>
find_in_list (*u_regs, prefix ! r);
THE (SUB_REGISTRY { reg, ... } )
=>
case (find (reg, r))
NULL => find_in_list (*u_regs, prefix ! r);
some_ctl => some_ctl;
esac;
esac;
end
also
fun find_in_list ([], _)
=>
NULL;
find_in_list (SUB_REGISTRY { reg, ... } ! r, path)
=>
case (find (reg, path))
NULL => find_in_list (r, path);
some_ctl => some_ctl;
esac;
end;
end;
# Initialize the control values in the
# registry from the unix environment,
# e.g. cm::foo from CM_FOO
#
fun set_up_controls_from_posix_environment (CONTROL_INDEX { control_set, q_regs, u_regs, ... } )
=
{ fun set_up_control { control, info=> { dictionary_name=>THE var }}
=>
case (wnx::process::get_env var)
#
THE value => ctl::set (control, value);
NULL => ();
esac;
set_up_control _ => ();
end;
fun set_up_subindex (SUB_REGISTRY { reg, ... } )
=
set_up_controls_from_posix_environment
reg;
cst::apply set_up_control control_set;
qht::apply set_up_subindex q_regs;
list::apply set_up_subindex *u_regs;
};
Index_Tree
=
INDEX_TREE {
path: List( String ),
help: String,
subregs: List( Index_Tree ),
control_set: List { control: ctl::Global_Control( String ),
info: Control_Info
}
};
sort_subregs
=
lms::sort_list
(\\ ( SUB_REGISTRY { menu_slot => rank1, ... },
SUB_REGISTRY { menu_slot => rank2, ... }
)
=
cf::menu_rank_gt (rank1, rank2)
);
fun controls (root, obs)
=
get_tree ([], root)
where
gather = case obs
#
NULL => (!);
#
THE obs => (\\ (x as SUB_REGISTRY { obscurity, ... }, l)
=
if (obscurity < obs) x ! l;
else l;
fi
);
esac;
# A function to build a list of subregistries,
# filtering by obscurity:
#
fun get_tree (path, root as CONTROL_INDEX { help, control_set, q_regs, u_regs, ... } )
=
INDEX_TREE {
help,
path => list::reverse path,
subregs => list::map get_reg subregs,
control_set => case obs
#
NULL => global_control_set::list_controls control_set;
THE obs => global_control_set::list_controls' (control_set, obs);
esac
}
where
subregs
=
list::fold_forward gather (qht::fold gather [] q_regs) *u_regs;
subregs
=
sort_subregs subregs;
fun get_reg (SUB_REGISTRY { prefix=>THE prefix, reg, ... } )
=>
get_tree (prefix ! path, reg);
get_reg (SUB_REGISTRY { reg, ... } )
=>
get_tree (path, reg);
end;
end;
end;
};
end;