PreviousUpNext

15.4.1291  src/lib/tk/src/toolkit/table.pkg

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

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



#  **************************************************************************
# tk-Tables



###               "It is better to excel in any single art
###                than to arrive only at mediocrity in several."
###
###                               -- Pliny the Younger



package table: (weak)  Table_Si_G               # Table_Si_G    is from   src/lib/tk/src/toolkit/table.api
{
    include tk;

    fun width (LIVE_TEXT { str, ... } )
        =
        {
            fun maxwidth (l . ls) n =>
                if (size l > n ) maxwidth ls (size l); else maxwidth ls n;fi;
               maxwidth _ n         => n; end;

            maxwidth (string::tokens (fn c => c == '\n'; end ) str) 0;
        };

    fun height (LIVE_TEXT { str, ... } )
        =
        length (string::tokens (fn c => c == '\n'; end ) str);

    fun table (cnf:  { constant_column_width:  Bool,
                      headline_relief:        tk::Relief_Kind,
                      headline_borderwidth:   Int,
                      headline_foreground:    Color,
                      headline_background:    Color,
                      field_relief:           tk::Relief_Kind,
                      field_borderwidth:      Int,
                      field_foreground:       Color,
                      field_background:       Color,
                      container_background:   Color
                   }
              )
              txts
        =
        {
            fun column_width n
                =
                {
                    fun column_width' (l . ls) m =>
                        {
                            w =
                                width (list::nth (l, n - 1))
                                except _ => 0; end ;

                            column_width' ls (int::max (w, m));
                        };
                       column_width' _ m         => m; end;

                    column_width' txts 0;
                };

            fun line_height n
                =
                {
                    fun line_height' (f . fs) m =>
                        line_height' fs (int::max (height f, m));
                       line_height' _ m         => m; end;

                    line_height'(list::nth (txts, n - 1)) 0;
                };

            fun max_column_width ()
                =
                {
                    fun single_line_maxwidth (f . fs) n =>
                        if (width f > n )
                            single_line_maxwidth fs (width f);
                        else single_line_maxwidth fs n;fi;
                       single_line_maxwidth _ n         => n; end;

                    fun max_column_width' (l . ls) n =>
                        if (single_line_maxwidth l 0 > n )
                            max_column_width' ls (single_line_maxwidth l 0);
                        else max_column_width' ls n;fi;
                       max_column_width' _ n         => n; end;

                    max_column_width' txts 0;
                };

            fun line (t . ts) r c
                =>
                TEXT_WIDGET { widget_id      => make_widget_id(),
                         live_text   => t,
                         scrollbars => NOWHERE,
                         packing_hints   => [ROW r, COLUMN c],
                         traits    => [   RELIEF (if (r == 1 ) cnf.headline_relief;
                                                else cnf.field_relief;fi),
                                         BORDER_THICKNESS (if (r == 1 ) cnf.headline_borderwidth;
                                                              else cnf.field_borderwidth;fi),
                                         WIDTH (if cnf.constant_column_width  max_column_width();
                                                                              else column_width c;fi),
                                         HEIGHT (line_height r), ACTIVE FALSE,
                                         FOREGROUND (if (r == 1 )
                                                        cnf.headline_foreground;
                                                    else cnf.field_foreground;fi),
                                         BACKGROUND (if (r == 1 )
                                                        cnf.headline_background;
                                                    else cnf.field_background;fi),
                                         CURSOR (XCURSOR("left_ptr", NULL))],
                         event_callbacks   => [] } .
                line ts r (c + 1);

               line [] _ _
                =>
                []; end;

            fun tab (l . ls) r => line l r 1 @ tab ls (r + 1);
               tab [] _        => []; end;

            widgets = tab txts 1;

            FRAME { widget_id    => make_widget_id(),
                   subwidgets  => GRIDDED widgets,
                   packing_hints => [],
                   traits  => [BACKGROUND cnf.container_background],
                   event_callbacks => [] };
        };

                                                                            my
    std_conf
        =
        {    constant_column_width => TRUE,
             headline_relief       => GROOVE,
             headline_borderwidth  => 1,
             headline_foreground   => BLACK,
             headline_background   => WHITE,
             field_relief          => RIDGE,
             field_borderwidth     => 1,
             field_foreground      => BLACK,
             field_background      => WHITE,
             container_background  => WHITE
        };
};


Comments and suggestions to: bugs@mythryl.org

PreviousUpNext