15.4.1477  src/lib/x-kit/widget/old/basic/widget-attributes.pkg

## widget-attributes.pkg
#
# High-level view of widget attributes.

# Compiled by:
#     src/lib/x-kit/widget/xkit-widget.sublib



###                    "Trust your technolust"
###
###                              -- Hackers


stipulate
    package wa =  widget_attribute_old;                         # widget_attribute_old          is from   src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg
    package wy =  widget_style_old;                             # widget_style_old              is from   src/lib/x-kit/widget/old/lib/widget-style-old.pkg
    package qk =  quark;                                        # quark                         is from   src/lib/x-kit/style/quark.pkg
herein

    package   widget_attributes
    : (weak)  Widget_Attributes                                 # Widget_Attributes             is from   src/lib/x-kit/widget/old/basic/widget-attributes.api
    {
        exception INVALID_ATTRIBUTE  String;
        #
        Attribute_Spec
            =
            ( wa::Name,
              wa::Type,
              wa::Value
            );

        Arg       = (wa::Name, wa::Value);
        View      = (wy::Style_View, wy::Widget_Style);

        Attributes
            =
            ATTRIBUTES  { lookup:  wa::Name -> wa::Value };

                                                                # typelocked_hashtable_g        is from   src/lib/src/typelocked-hashtable-g.pkg
        package qht
            =
            typelocked_hashtable_g (
                #
                Hash_Key   = qk::Quark;
                hash_value = qk::hash;
                same_key   = qk::same;
            );

        fun okay (attribute_specs:  List(Attribute_Spec)) n
            =
            list::find (\\ s = qk::same (n,#1 s)) attribute_specs;

        fun add (okay, table) (n, v)
            =
            case (okay n)   
                THE (_, t, _) =>  qht::set table (n, (v, t));
                NULL          =>  ();
            esac;

        fun attributes ((name, style), attribute_specs, [])
                =>
                ATTRIBUTES { lookup => wy::find_attributes style (name, attribute_specs) };

            attributes ((name, style), attribute_specs, args)
                =>
                {   convert =  wa::convert_attribute_value (wy::context_of style);
                    #
                    base    =  wy::find_attributes style (name, attribute_specs);

                    table   =  qht::make_hashtable  { size_hint => 8,  not_found_exception => DIE "widget-attributes" };

                    fun lookup n
                        =
                        case (qht::find table n)
                            #
                            THE v =>  convert v;
                            NULL  =>  base n;
                        esac;

                    apply (add (okay attribute_specs, table)) args;

                    ATTRIBUTES { lookup };
                };
        end;

        fun find_attribute (ATTRIBUTES { lookup } ) name
            = 
            (lookup name)
            except _ = raise exception INVALID_ATTRIBUTE (qk::string_of name);

    };          #  WidgetAttrs 

end;

## COPYRIGHT (c) 1991, 1994 by AT&T Bell Laboratories.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.