## 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 package 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 (\\ c => c == '\n'; end ) str) 0;
};
fun height (LIVE_TEXT { str, ... } )
=
length (string::tokens (\\ 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
};
};