PreviousUpNext

15.4.1306  src/lib/tk/src/toolkit/widget_box.pkg

## widget_box.pkg
## (C) 1999, Bremen Institute for Safe Systems, Universitaet Bremen
## Author: ludi

# Compiled by:
#     src/lib/tk/src/toolkit/sources.sublib



# ***************************************************************************
# Widget boxes
# **************************************************************************



###                    "To know all about anything is
###                     to know how to deal with it
###                     under all circumstances."
###
###                              -- William Kingdon Clifford



package widget_box: (weak)  Widget_Box          # Widget_Box    is from   src/lib/tk/src/toolkit/widget_box.api

{
    include tk;

    exception WIDGET_BOX;

     Wbox_Item_Id = Text_Item_Id;

    fun widget_box (box_def:  { widget_id:       Widget_Id,
                             scrollbars:  Scrollbars_At,
                             subwidgets:     List( Widget ),
                             packing_hints:  List( Packing_Hint ),
                             traits:      List( Trait ),
                             event_callbacks:    List( Event_Callback )
                            } ) =
        {
            fun annos (w . ws) l => TEXT_ITEM_WIDGET { text_item_id    => make_text_item_id(),
                                            mark     => MARK (l, 0),
                                            subwidgets  => PACKED [w],
                                            traits => [],
                                            event_callbacks => [] }
                                  . annos ws (l+1);
               annos [] l      => []; end;
        
            TEXT_WIDGET { widget_id      => box_def.widget_id,
                    scrollbars => box_def.scrollbars,
                    live_text   =>
                      LIVE_TEXT { len         => NULL,
                                str         => "",
                                text_items => annos box_def.subwidgets 1 },
                    packing_hints   => box_def.packing_hints,
                    traits    => [CURSOR (XCURSOR("arrow", NULL)),
                                  ACTIVE FALSE] @
                                 box_def.traits,
                    event_callbacks   => box_def.event_callbacks };
        };

    fun insert_widget_box_at (id, l) w =
        {
            ann_id = make_text_item_id();
        
            { add_trait id [ACTIVE TRUE];
             add_text_item id (TEXT_ITEM_WIDGET { text_item_id    => ann_id,
                                         mark     => MARK (l, 0),
                                         subwidgets  => PACKED [w],
                                         traits  => [],
                                         event_callbacks => [] } );
             add_trait id [ACTIVE FALSE];
             ann_id;}
            except errors => raise exception WIDGET_BOX; end ;
        };

    fun insert_widget_box_at_end id w =
        {
            ann_id = make_text_item_id();
        
            { add_trait id [ACTIVE TRUE];
             add_text_item id (TEXT_ITEM_WIDGET { text_item_id    => ann_id,
                                         mark     => MARK_END,
                                         subwidgets  => PACKED [w],
                                         traits  => [],
                                         event_callbacks => [] } );
             add_trait id [ACTIVE FALSE];
             ann_id;}
            except errors => raise exception WIDGET_BOX; end ;
        };

    fun del_widget_box id it_id
        =
        delete_text_item id it_id;

    fun clear_widget_box id
        =
        {
            fun clear (ann . anns) => { delete_text_item (id ) (get_text_item_id ann);
                                     clear anns;};
                clear []           => ();
            end;
        
            { add_trait id [ACTIVE TRUE];
              clear (get_text_widget_text_items (get_widget (id )));
              clear_text id;
              add_trait id [ACTIVE FALSE];
            }
            except errors = raise exception WIDGET_BOX;
        };

    fun replace_widget_box (wid, nuwidgets)
        = 
        {   clear_widget_box wid;
            list::map (insert_widget_box_at_end wid) nuwidgets;
        };

};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext