15.4.753  src/lib/global-controls/global-control-set.pkg

## global-control-set.pkg

# Compiled by:
#     src/lib/global-controls/global-controls.lib


stipulate
    package ctl =  global_control;                                      # global_control                is from   src/lib/global-controls/global-control.pkg
    package cf  =  global_control_forms;                                # global_control_forms          is from   src/lib/global-controls/global-control-forms.pkg
    package qht =  quickstring_hashtable;                               # quickstring_hashtable         is from   src/lib/src/quickstring-hashtable.pkg
    package lms =  list_mergesort;                                      # list_mergesort                is from   src/lib/src/list-mergesort.pkg
herein

    package   global_control_set
    : (weak)  Global_Control_Set                                        # Global_Control_Set            is from   src/lib/global-controls/global-control-set.api
    {
        Global_Control(X)         =  ctl::Global_Control(X);
        Global_Control_Set (X, Y) =  cf::Global_Control_Set( X, Y ); 

        fun make_control_set ()
            =
            qht::make_hashtable  { size_hint => 16,  not_found_exception => DIE "control set" };

        fun member (cset, name)
            =
            case (qht::find cset name)
                #
                NULL =>  FALSE;
                _    =>  TRUE;
            esac;

        fun find (cset, name)
            =
            qht::find cset name;

        fun set (cset, control as cf::GLOBAL_CONTROL { name, ... }, info)
            =
            qht::set cset (name, { control, info } );

        fun drop (cset, name)
            =
            case (qht::find cset name)
                #
                NULL =>  ();
                _    =>  qht::drop cset name;
            esac;

        fun info_of (cset:   Global_Control_Set(X, Y)) (cf::GLOBAL_CONTROL { name, ... } )
            =
            null_or::map .info (qht::find cset name);

        # list the members; the list is ordered by descreasing priority.  The
        # listControls' function allows one to specify an obscurity level; controls
        # with equal or higher obscurioty are omitted from the list.

        stipulate
            fun menu_rank_of { control => cf::GLOBAL_CONTROL { menu_slot, ... }, info }
                =
                menu_slot;

            fun gt (a, b)
                =
                cf::menu_rank_gt
                  (
                    menu_rank_of  a,
                    menu_rank_of  b
                  );
        herein

            fun list_controls  cset
                =
                lms::sort_list gt (qht::vals_list cset);

            fun list_controls' (cset, obs)
                =
                lms::sort_list gt (qht::fold add [] cset)
                where
                    fun add (item as { control => cf::GLOBAL_CONTROL { obscurity, ... }, info }, l)
                        =
                        if (obs > obscurity)   item ! l;
                        else                          l;
                        fi;

                end;

        end;

        fun apply f cset
            =
            qht::apply f cset;

        # Convert the controls in a set
        # to string controls and create
        # a new set for them:
        #
        fun convert_to_string_controls
                convert
                control_set
            =
            {   string_control
                    =
                    ctl::make_string_control   convert;

                fun convert_control { control, info }
                  =
                  { control => string_control control,
                    info
                  };

                qht::map convert_control   control_set;
            };

    };
end;


## COPYRIGHT (c) 2002 Bell Labs, Lucent Technologies
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.