PreviousUpNext

15.4.1408  src/lib/x-kit/widget/leaf/textlist.pkg

## textlist.pkg
#
# See also: The Selectable List from Appendix C of
#     Revitalizing eXene
#     http:://mythryl.org/pub/exene/matt-thesis.pdf


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



# List widget, for text lists.
#
# NOTE: with the value restriction, it might be better to code this
# as a generic.           XXX BUGGO FIXME



###        "Since the invention of the microprocessor, the
###         cost of moving a byte of information around has
###         fallen on the order of 10-million-fold.
###
###        "Never before in the human history has any product
###         or service gotten 10 million times cheaper -- much
###         less in the course of a couple decades.
###
###        "That's as if a 747 plane, once at $150 million apiece,
###         could now be bought for about the price of a large pizza."
###
###                                 -- Michael Rothschild

stipulate
    include threadkit;                          # threadkit             is from   src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg
    #
    package xg =  xgeometry;                    # xgeometry             is from   src/lib/std/2d/xgeometry.pkg
    #
    package xc =  xclient;                      # xclient               is from   src/lib/x-kit/xclient/xclient.pkg
    #
    package wg =  widget;                       # widget                is from   src/lib/x-kit/widget/basic/widget.pkg
    package wa =  widget_attribute;             # widget_attribute      is from   src/lib/x-kit/widget/lib/widget-attribute.pkg
    package wt =  widget_types;                 # widget_types          is from   src/lib/x-kit/widget/basic/widget-types.pkg
    #
    package d3 =  three_d;                      # three_d               is from   src/lib/x-kit/widget/lib/three-d.pkg
    package ti =  item_list;                    # item_list             is from   src/lib/x-kit/widget/leaf/item-list.pkg
    package li =  list_indexing;                # list_indexing         is from   src/lib/x-kit/widget/lib/list-indexing.pkg
    #
herein

    package   textlist
    : (weak)  Textlist                          # Textlist              is from   src/lib/x-kit/widget/leaf/textlist.api
    {
        exception BAD_INDEX
            =
            ti::BAD_INDEX;


        Textlist_Item(X)
            =
            ( String,                           # String to display on this line of widget.
              X,                                        # Value to return when this line is clicked by user.
              wt::Button_State                  # Initial state of line: (in/active, de/selected).
            );

        fun make_textlist_item x
            =
            x;

        List_Event(X) = SET(X)
                      | UNSET(X);

        Result = OKAY
               | ERROR  Exception;

        Input = BUTTON  (xc::Mousebutton, xg::Point);


        # Input imp.
        #
        # At present it simply reports button down
        # with which button and where.
        #
        fun input (m, in_slot)
            =
            loop ()
            where 
                fun loop ()
                    =
                    case (xc::envelope_contents  (block_until_mailop_fires  m))
                        #                  
                        xc::MOUSE_FIRST_DOWN { mouse_button, window_point, ... }
                            =>
                            {   put_in_mailslot  (in_slot,  BUTTON (mouse_button, window_point));

                                wait_up ();
                            };

                         _ => loop ();
                    esac

                also
                fun wait_up ()
                    =
                    case (xc::envelope_contents  (block_until_mailop_fires  m))
                        #                  
                        xc::MOUSE_LAST_UP _ => loop ();
                        _                   => wait_up ();
                    esac;
            end;

         Plea_Mail(X)
           = GET_SIZE_CONSTRAINT  Oneshot_Maildrop( wg::Widget_Size_Preference )
           #
           | SET_CHOSEN  (List ((Int, Bool)), Oneshot_Maildrop( Result ))
           | SET_ACTIVE  (List ((Int, Bool)), Oneshot_Maildrop( Result ))
           #
           | INSERT      ((Int,  List ((String, X))), Oneshot_Maildrop( Result ))
           | DELETE      (List( Int ), Oneshot_Maildrop( Result ))
           #
           | GET_CHOSEN   Oneshot_Maildrop( List( Int ) )
           | GET_STATE    Oneshot_Maildrop( List( wt::Button_State ) )
           #
           | DO_REALIZE  { kidplug:      xc::Kidplug,
                           window:       xc::Window,
                           window_size:  xg::Size
                         }
           ;

         Item(X)
            =
            { label:  String,           # Label of item 
              lb:     Int,                      # Left bearing of label.
              wid:    Int,                      # Width in pixels of label. 
              value:  X                 # Value of item. 
            };

         Textlist(X)
             =
             TEXTLIST
               { widget:            wg::Widget,
                 plea_slot:         Mailslot( Plea_Mail(X) ),
                 textlist_change':  Mailop(  List_Event(X) )
               };

        default_font = "-Adobe-Helvetica-Bold-R-Normal--*-120-*";

        # Standard font information 
        #
        fun make_font_info font
            =
            {   (xc::font_high font)
                    ->
                    { ascent  => font_ascent,
                      descent => font_descent
                    };

               (font, font_ascent, font_descent);
            };

        # x and y increments for scrolling and drawing
        # x increment is nominally the width of "0", which doesn't
        # work for non-constant width fonts.
        # y increment is height of item
        #
        fun set_xincr font
            =
            xc::text_width font "0";

        fun set_yincr ((_, font_ascent, font_descent), bw)
                =
                1 + font_ascent + font_descent + 2*bw;

        attributes
            =
            [
    #         (wa::attribute_multiset,  wa::BOOL,    wa::BOOL_VAL FALSE), 
    #         (wa::attribute_isVertical,wa::BOOL,    wa::BOOL_VAL TRUE), 
    #         (wa::halign,              wa::HALIGN,  wa::HALIGN_VAL wg::HLeft), 
              (wa::border_thickness,        wa::INT,     wa::INT_VAL 2),
              (wa::font,                wa::FONT,    wa::STRING_VAL default_font),
              (wa::color,               wa::COLOR,   wa::NO_VAL),
              (wa::relief,              wa::RELIEF,  wa::RELIEF_VAL wg::FLAT),
              (wa::width,               wa::INT,     wa::INT_VAL 0),
              (wa::height,              wa::INT,     wa::INT_VAL 0),
              (wa::background,          wa::COLOR,   wa::STRING_VAL "white"),
              (wa::foreground,          wa::COLOR,   wa::STRING_VAL "black"),
              (wa::select_border_thickness, wa::INT,     wa::INT_VAL 1)
          ];

        color_attributes
            =
            [ (wa::select_background,    wa::COLOR,   wa::STRING_VAL "gray"),
              (wa::select_foreground,    wa::COLOR,   wa::STRING_VAL "black")
            ];

        mono_attributes
            =
            [
              (wa::select_background,    wa::COLOR,   wa::STRING_VAL "black"),
              (wa::select_foreground,    wa::COLOR,   wa::STRING_VAL "white")
            ];


        Result
            =
            { multi:    Bool,
              shades:   wg::Shades,
              fontinfo:  (xc::Font, Int, Int),
              # 
              fg:      xc::Rgb,
              bg:      xc::Rgb,
              sel_fg:  xc::Rgb,
              # 
              relief:  wg::Relief,
              border_thickness:  Int,
              maxslen:  Ref( Int ),
              stipple:  xc::Ro_Pixmap,
              # 
              xincr:   Int,
              yincr:   Int,
              width:   Int,
              height:  Int,
              # 
              sel_shades:  wg::Shades,
              sel_border_thickness:  Int
            };

        State(X)
            =
            { items:      ti::Items( Item(X) ),
              top:        Int,
              line_count: Int
            };

        fun make_result (root, view, args)
            =
            {   attributes
                    =
                   (wg::is_monochrome root)
                     ??  mono_attributes @ attributes
                     ::  color_attributes @ attributes;

                attributes
                    =
                    wg::find_attribute (wg::attributes (view, attributes, args));

                my fontinfo as (f, _, _)
                    =
                    make_font_info (wa::get_font (attributes wa::font));

                relief = wa::get_relief (attributes wa::relief);

                border_thickness  = wa::get_int (attributes wa::border_thickness       );
                sborder_width = wa::get_int (attributes wa::select_border_thickness);

                forec  = wa::get_color (attributes wa::foreground);
                backc  = wa::get_color (attributes wa::background);

                sforec = wa::get_color (attributes wa::select_foreground);
                sbackc = wa::get_color (attributes wa::select_background);

                { multi => FALSE,
                  fontinfo,
                  height => int::max (0, wa::get_int (attributes wa::height)),
                  width  => int::max (0, wa::get_int (attributes wa::width)),
                  maxslen => REF 0,
                  stipple => wg::ro_pixmap root "gray",

                  xincr => set_xincr (#1 fontinfo),
                  yincr => set_yincr (fontinfo, sborder_width),

                  fg => forec,
                  bg => backc,

                  shades => wg::shades root backc,
                  border_thickness => int::max (border_thickness, 0),

                  sel_shades => wg::shades root sbackc,
                  sel_fg => sforec,
                  sel_border_thickness => int::max (sborder_width, 0),

                  relief
                };
            };

        fun make_item' (result:  Result)
            =
            make_item
            where 

                my (font, _, _) =   result.fontinfo;

                fun make_item (str, v)
                    =
                    {   my xc::CHAR_INFO { left_bearing=>lb, right_bearing=>rb, ... }
                            =
                            .overall_info (xc::text_extents font str);

                        { label => str, lb, wid => rb - lb, value => v };
                    };
            end;

        fun make_items
            ( result:      Result,
              event_slot,
              items:       List( Textlist_Item(X) )
            )
            =
            {   fun make_item i
                    =
                    make_item' result i;

                maxslen
                    =
                    list::fold_forward
                        (fn ((s, _, _), m) =  int::max (m, size s))
                        0
                        items;

                fun mki (s, v, state)
                    =
                    (make_item (s, v), state);


                fun pickfn ( { value, ... } : Item(X), TRUE) =>   put_in_mailslot  (event_slot,  SET   value);
                    pickfn ( { value, ... } : Item(X), _)    =>   put_in_mailslot  (event_slot,  UNSET value);
                end;


                result.maxslen := maxslen;


                ti::items
                  {
                    items    =>  map mki items,
                    multiple =>  result.multi,
                    pickfn
                  };
            };

        fun size_preference_thunk_of (result as { yincr, xincr, maxslen, ... } : Result, items)
            =
            {   count = ti::vals_count items;

                xbase = 2*(result.border_thickness + result.sel_border_thickness);

                my (xmin, xnat, xmax)
                    =
                    case result.width   
                        #
                        0 =>  (1, *maxslen+1, NULL );
                        w =>  (w, w,          THE w);
                    esac;

                col_preference
                    =
                    wg::INT_PREFERENCE { start_at=>xbase, step_by=>xincr, min_steps=>xmin, ideal_steps=>xnat, max_steps=>xmax };

                ybase = 2*result.border_thickness;

                # This changes once we have scroll bars.  XXX BUGGO FIXME

                my (ymin, ynat, ymax)
                    =
                    case result.height
                        #                  
                        0      =>  (count,  count,  THE count );
                        height =>  (height, height, THE height);
                    esac;

                row_preference
                    =
                    wg::INT_PREFERENCE { start_at=>ybase, step_by=>yincr, min_steps=>ymin, ideal_steps=>ynat, max_steps=>ymax };

                { col_preference, row_preference };
            };

        fun drawfns (result:  Result, window)
            =
            (draw, update)
            where 
                fun is_active (wt::ACTIVE _) =>  TRUE;
                    is_active _              =>  FALSE;
                end;

                fun is_on (  wt::ACTIVE v) =>  v;
                    is_on (wt::INACTIVE v) =>  v;
                end;

                dr =  xc::drawable_of_window  window;

                bw = result.border_thickness;

                txt_pen =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb  result.fg)];

                i_txt_pen =  xc::clone_pen (txt_pen,
                                [xc::p::FILL_STYLE_STIPPLED, xc::p::STIPPLE result.stipple]);

                sel_txt_pen =  xc::make_pen [xc::p::FOREGROUND (xc::rgb8_from_rgb  result.sel_fg)];

                i_sel_txt_pen =  xc::clone_pen (txt_pen,
                                [xc::p::FILL_STYLE_STIPPLED, xc::p::STIPPLE result.stipple]);

                fun draw_item (clr, bw, xg::SIZE { wide, high } )
                    =
                    d
                    where 

                        sbw = result.sel_border_thickness;
                        row_incr = result.yincr;

                        result.sel_shades ->  selshades as { base=>selbase, ... };
                        result.shades   -> { base, ... };
                        result.fontinfo ->  (font, font_ascent, _);

                        inset = bw + sbw + (result.xincr / 2);
                        iwid = wide - 2*bw;

                        fun d (( { label, lb, ... } : Item(X), st), row)
                            =
                            {   r = xg::BOX { col=>bw, row, wide=>iwid, high=>row_incr };

                                row_t = row + font_ascent + sbw;
                                col_t = inset - lb;

                                if (is_on st)

                                   tpen = if (is_active st)   sel_txt_pen; 
                                          else              i_sel_txt_pen;
                                          fi;

                                    xc::fill_box dr selbase r;

                                    xc::draw_transparent_string dr tpen font (xg::POINT { col=>col_t, row=>row_t }, label);

                                    d3::draw_box dr 
                                      { box=>r, width=>sbw, relief=>d3::RAISED } selshades;

                                else
                                    tpen = if (is_active st)    txt_pen;
                                           else               i_txt_pen;
                                           fi;

                                    if clr  xc::fill_box dr base r; fi;

                                    xc::draw_transparent_string dr tpen font (xg::POINT { col=>col_t, row=>row_t }, label);
                                fi;

                                row + row_incr;
                            };
                    end;

                # Update items given by list of integers.
                # Assume the list is sorted:
                #
                fun update (me:  State(X), cl, size)
                    =
                    draw (strip cl)
                    where 
                        me ->  { items, top, line_count };

                        bot = top + line_count;
                        bw = result.border_thickness;

                        yincr = result.yincr;

                        draw_item =  fn i = draw_item (TRUE, bw, size) i;

                        fun strip [] => [];
                            strip (l as (i ! t)) => if (i < top)  strip t; else l;fi;
                        end;

                        fun loop (_, _,[], _) => ();
                            loop([], _, _, _) => ();

                            loop (i ! t, j, l ! ls, y)
                               =>
                               if   (i >= bot ) ();
                               elif (i > j)     loop (i ! t, j+1, ls, y+yincr);
                               else             draw_item (l, y);
                                                loop (t, j+1, ls, y+yincr);
                               fi;
                        end;

                        fun draw []
                                =>
                                ();

                            draw [i]
                                =>
                                if (i < bot)
                                    draw_item (ti::item (items, i), bw+yincr*(i-top));
                                    ();
                                fi;

                            draw (l as (i ! t))
                                => 
                                if (i < bot)
                                    loop (l, i, ti::vals_list (items, i, bot-i), bw+yincr*(i-top));
                                fi;
                        end;
                    end;

                # Redraw entire widget:
                #
                fun draw ( { items, top, line_count } : State(X), size as xg::SIZE { wide, high } )
                    =
                    {   box = xg::BOX { col=>0, row=>0, wide, high };

                        relief = result.relief;
                        bw = result.border_thickness;

                        result.shades ->  shades as { base, ... };

                        il = ti::vals_list (items, top, line_count);

                        draw_item =   fn i = draw_item (FALSE, bw, size) i;

                        xc::fill_box dr base box;

                        list::fold_forward  draw_item  bw  il;

                        d3::draw_box dr { box, relief, width=>bw } shades;
                    };
            end;

        # Returns whether to send a plea for size change.
        # At present, we only do this if height attribute is 0,
        # meaning the user has not specified a fixed height, so
        # we try to fit the total number of items.
        #
        fun new_size ( { height, ... } : Result, _)
            =
            height == 0; 

        # Translate a point in window coordinates to
        # the index of an item. The y value must actually lie
        # within the item; we don't care about the x.
        #
        fun pt_to_index (xg::POINT { col, row }, result:  Result, top, vals_count)
            =
            {   row' = (row - result.border_thickness) / result.yincr;

                index = row' + top;

                if (row' < 0 or index >= vals_count)  NULL;
                else                                  THE index;
                fi;
            };

        #  Given a window size, compute how many items can be displayed.
        # 
        fun get_num_lines ( { border_thickness, yincr, ... } : Result, xg::SIZE { high, ... } )
            =
            int::max (0, (high - 2*border_thickness) / yincr);

        # Generate a list of length len of consecutive integers 
        # starting at start.
        #
        fun genl (start, len)
            =
            loop (start, len,[])
            where 
                fun loop (_, 0, l) => reverse l;
                    loop (i, len, l) => loop (i+1, len - 1, i ! l);
                end;
            end;

        fun update_max (items:   ti::Items (Item(X)), maxslen)
            =
            maxslen := ti::revfold (fn ( { label, ... }, m) => int::max (m, size label); end ) 0 items;


        # Given the current top, the number of lines in the window,
        # the new number of items, and the list of items that have
        # been deleted, compute the new top and also whether the
        # window needs to be redisplayed.
        #
        fun top_on_delete (top, line_count, item_count, l)
            =
            {
                l = li::check_sort l;

                fun prei (count,[])
                        =>
                        (count, []);

                    prei (arg as (count, i ! t))
                        =>
                        if (i < top)   prei (count+1, t);
                        else           arg;
                        fi;
                end;

                my (count, dl) = prei (0, l);

                top' = top - count;

                case dl   
                  [] => (top', FALSE);
                 (i ! _) => if   (i >= top + line_count )              (top', FALSE);
                            elif (top' + line_count <= item_count )    (top', TRUE);
                            else                                       (int::max (0, item_count - line_count), TRUE);
                            fi;
                esac;
            };

        fun realize ( { kidplug, window, window_size => size' }, result, items, plea')
            =
            {   my  xc::KIDPLUG { from_other', to_mom, from_mouse', from_keyboard' }
                    =
                    xc::ignore_keyboard  kidplug;

                in_slot = make_mailslot ();

                in'     =  take_from_mailslot'  in_slot;

                my (draw, update)
                    =
                    drawfns (result, window);

                size' = REF size';

                fun set_chosen (l, { items, top, line_count } )
                    =
                    {   my (items', optp)
                            =
                            ti::set_chosen (items, l);

                        me' = { items=>items', top, line_count };

                        l = map (fn (i, _) = i) l;

                        l = case optp
                                   THE i => i ! l;
                                   NULL  => l;
                            esac;

                        update (me', li::check_usort l, *size');

                        me';
                    };

                fun do_plea (GET_SIZE_CONSTRAINT reply_1shot, me as { items, top, line_count } )
                        => 
                        {   put_in_oneshot  (reply_1shot, size_preference_thunk_of (result, items));
                            me;
                        };

                    do_plea (GET_CHOSEN reply_1shot, me)
                        =>
                        {   put_in_oneshot  (reply_1shot, ti::get_chosen me.items);
                            me;
                        };

                    do_plea (GET_STATE reply_1shot, me)
                        =>
                        {   put_in_oneshot  (reply_1shot, ti::get_state me.items);
                            me;
                        };

                    do_plea (SET_ACTIVE (l, reply_1shot), me)
                        =>
                        {   items' = ti::set_active (me.items, l);
                            #
                            me' =  { items=>items', top => me.top, line_count => me.line_count };

                            put_in_oneshot (reply_1shot, OKAY);

                            update (me', li::check_usort (map (fn (i, _) = i) l), *size');

                            me';
                        }
                        except e
                            =
                            {   put_in_oneshot (reply_1shot, ERROR e);
                                me;
                            };

                    do_plea (SET_CHOSEN (l, reply_1shot), me)
                        =>
                        {   me' = set_chosen (l, me);

                            put_in_oneshot (reply_1shot, OKAY); me';
                        }
                        except e
                            =
                            {   put_in_oneshot (reply_1shot, ERROR e);
                                me;
                            };

                    do_plea (INSERT((i, l), reply_1shot), me as { top, items, line_count } )
                        =>
                        {   maxslen = list::fold_forward (fn ((s, _), m) = int::max (m, size s)) 0 l;

                            items' = ti::set (items, i, map (make_item' result) l);
                            item_count' = ti::vals_count items';

                            count = length l;
                            bot = top + line_count;

                            my (top', redraw)
                                =
                                if   (i <  top)   (top + count, FALSE);
                                elif (i >= bot)   (top, FALSE);
                                else              (top, TRUE);
                                fi;

                            me' = { items=>items', top => top', line_count };

                            put_in_oneshot (reply_1shot, OKAY);

                            if (new_size (result, items') )
                                #
                                block_until_mailop_fires  (to_mom  xc::REQ_RESIZE);
                            fi;

                            if redraw 
                                 update (me', genl (i, int::min (bot-i, item_count'-i)),*size'); 
                            fi;

                            result.maxslen := maxslen;
                            me';
                       }
                       except e
                           =
                           {   put_in_oneshot  (reply_1shot, ERROR e);
                               me;
                           };

                    do_plea (DELETE (arg, reply_1shot), me as { top, items, line_count } )
                        =>
                        {   items' = ti::delete (items, arg);
                            item_count' = ti::vals_count items';

                            (top_on_delete (top, line_count, item_count', arg))
                                ->
                                (top', redraw);

                            me' =  { items=>items', top => top', line_count };

                            put_in_oneshot (reply_1shot, OKAY);

                            if (new_size (result, items'))
                                #
                                block_until_mailop_fires  (to_mom  xc::REQ_RESIZE);
                            fi;

                            redraw   ?:   draw (me', *size');

                            update_max (items', result.maxslen);

                            me';
                        }
                        except e
                            =
                            {   put_in_oneshot (reply_1shot, ERROR e);
                                me;
                            };

                    do_plea (_, me)
                        =>
                        me;
                end;


                fun do_in (BUTTON (but, pt), me)
                    =
                    {   fun on_off (xc::MOUSEBUTTON 1) =>  TRUE;
                            on_off _                   =>  FALSE;
                        end;

                        case (pt_to_index (pt, result, me.top, ti::vals_count me.items))   
                            #
                            THE index =>  set_chosen ([(index, on_off but)], me);
                            NULL      =>  me;
                        esac;
                    }; 


                fun do_mom (xc::ETC_RESIZE (xg::BOX { wide, high, ... } ),{ items, top, line_count } )
                        =>
                        {   newsz = xg::SIZE { wide, high };

                            line_count = get_num_lines (result, newsz);

                            size' := newsz;

                            { items, top, line_count };
                        };

                    do_mom (xc::ETC_REDRAW _, me)
                        =>
                        {   draw (me,*size');
                            me;
                        };

                    do_mom (_, me)
                        =>
                        me;
                end;


                fun main me
                    =
                    do_one_mailop [
                        plea'       ==>  (fn r        =  main (do_plea (r, me))),
                        from_other' ==>  (fn envelope =  main (do_mom  (xc::envelope_contents envelope, me))),
                        in'         ==>  (fn i        =  main (do_in   (i, me)))
                    ];


                make_thread  "textlist from_mouse"  .{
                    #
                    input (from_mouse', in_slot);
                };

                main { items, top=>0, line_count=>get_num_lines (result, *size') };
            };

        fun init (result, items, plea')
            =
            loop items
            where 

                fun do_plea (GET_SIZE_CONSTRAINT reply_1shot, items)
                        => 
                        {   put_in_oneshot (reply_1shot, size_preference_thunk_of (result, items));
                            items;
                        };

                    do_plea (GET_CHOSEN reply_1shot, items)
                        =>
                        {   put_in_oneshot (reply_1shot, ti::get_chosen items);
                            items;
                        };

                    do_plea (GET_STATE reply_1shot, me)
                        =>
                        {   put_in_oneshot (reply_1shot, ti::get_state items);
                            items;
                        };

                    do_plea (SET_CHOSEN (l, reply_1shot), items)
                        =>
                        {   (ti::set_chosen (items, l))
                                ->
                                (items', _);

                            put_in_oneshot (reply_1shot, OKAY);

                            items';
                        }
                        except e = {  put_in_oneshot (reply_1shot, ERROR e);   items;  };

                    do_plea (SET_ACTIVE (l, reply_1shot), items)
                        =>
                        {   items' = ti::set_active (items, l);
                            #
                            put_in_oneshot (reply_1shot, OKAY);

                            items';
                        }
                        except e = {   put_in_oneshot (reply_1shot, ERROR e);
                                       items;
                                   };

                    do_plea (INSERT ((i, il), reply_1shot), items)
                        =>
                        {   items' = ti::set (items, i, map (make_item' result) il);

                            maxslen = list::fold_forward
                                          (fn ((s, _), m) = int::max (m, size s))
                                          0
                                          il;

                            put_in_oneshot (reply_1shot, OKAY);

                            result.maxslen :=  maxslen;

                            items';
                        }
                        except e = {   put_in_oneshot (reply_1shot, ERROR e);
                                       items;
                                   };

                    do_plea (DELETE (arg, reply_1shot), items)
                        =>
                        {   items' = ti::delete (items, arg);
                            #
                            update_max (items', result.maxslen);

                            put_in_oneshot (reply_1shot, OKAY);

                            items';
                        }
                        except e = {   put_in_oneshot (reply_1shot, ERROR e);
                                       items;
                                   };

                    do_plea (DO_REALIZE arg, items)
                        =>
                        realize (arg, result, items, plea');
                end;

                fun loop items
                    =
                   loop (do_plea (block_until_mailop_fires plea', items));
            end;

        fun make_textlist (root_window, view, args) items
            =
            {   event_slot =  make_mailslot ();
                plea_slot  =  make_mailslot ();

                result  = make_result (root_window, view, args);
                items   = make_items (result, event_slot, items);

                fun size_preference_thunk_of ()
                    =
                    {   reply_1shot =  make_oneshot_maildrop ();
                        #
                        put_in_mailslot  (plea_slot,  GET_SIZE_CONSTRAINT reply_1shot);

                        take_from_oneshot  reply_1shot;
                    };

                w = wg::make_widget
                      {
                        root_window,
                        size_preference_thunk_of,
                        #       
                        args    =>  fn ()  =  { background => THE result.bg },
                        #       
                        realize =>  fn arg =  put_in_mailslot  (plea_slot,  DO_REALIZE arg)
                      };


                make_thread  "textlist"  .{

                    init ( result,
                           items,
                           take_from_mailslot'  plea_slot
                         );
                };


                TEXTLIST
                  { plea_slot,
                    #
                    widget =>  w,

                    textlist_change'
                        =>
                        take_from_mailslot'  event_slot
                  };
            };


        fun textlist_change'_of (TEXTLIST { textlist_change',  ... } )
            =
            textlist_change';


        fun as_widget (TEXTLIST { widget,  ... } )
            =
            widget;


        fun set_f f (TEXTLIST { plea_slot, ... } ) arg
            =
            {   reply_1shot = make_oneshot_maildrop ();

                put_in_mailslot  (plea_slot,  f (arg, reply_1shot));

                case (take_from_oneshot  reply_1shot)
                    #  
                    OKAY    => ();
                    ERROR e => raise exception e;
                esac;
            };


        fun set_textlist_selections l
            =
            set_f SET_CHOSEN l;


        fun set_textlist_active_items l
            =
            set_f SET_ACTIVE l;


        fun insert l =   set_f INSERT l;
        fun delete l =   set_f DELETE l;


        fun append tl (i, items)
            =
            insert tl (i+1, items);


        fun get_f f (TEXTLIST { plea_slot, ... } )
            =
            {   reply_1shot =  make_oneshot_maildrop ();
                #
                put_in_mailslot  (plea_slot,  f reply_1shot);

                take_from_oneshot  reply_1shot;
            };


        fun get_textlist_selections l
            =
            get_f  GET_CHOSEN  l;


        fun get_textlist_item_states  l
            =
            get_f  GET_STATE   l;

    };                                                  # package textlist 

end;


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext