## widget-attribute-old.pkg
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib# Types to add: FontList, Atom
### "If the formal definition of a feature
### gets very messy and complicated,
### you should not ignore that warning."
###
### -- E.J. Dijkstra
# This package is used as arg to widget_style_g in:
#
# src/lib/x-kit/widget/old/lib/widget-style-old.pkgstipulate
package d3 = three_d; # three_d is from src/lib/x-kit/widget/old/lib/three-d.pkg package f8b = eight_byte_float; # eight_byte_float is from src/lib/std/eight-byte-float.pkg package qk = quark; # quark is from src/lib/x-kit/style/quark.pkg package f = sfprintf; # sfprintf is from src/lib/src/sfprintf.pkg package ss = substring; # substring is from src/lib/std/substring.pkg package wt = widget_types; # widget_types is from src/lib/x-kit/widget/old/basic/widget-types.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg package xrs = xc::cursors_old; # cursors_old is from src/lib/x-kit/xclient/src/window/cursors-old.pkgherein
package widget_attribute_old
: (weak) Widget_Attribute_Old # Widget_Attribute_Old is from src/lib/x-kit/widget/old/lib/widget-attribute-old.api {
Name = qk::Quark;
active = qk::quark "active";
aspect = qk::quark "aspect";
arrow_dir = qk::quark "arrowDir";
background = qk::quark "background";
border_color = qk::quark "borderColor";
border_thickness = qk::quark "borderWidth";
color = qk::quark "color";
current = qk::quark "current";
cursor = qk::quark "cursor";
font = qk::quark "font";
font_list = qk::quark "fontList";
font_size = qk::quark "fontSize";
foreground = qk::quark "foreground";
from_value = qk::quark "fromValue";
gravity = qk::quark "gravity";
halign = qk::quark "halign";
height = qk::quark "height";
icon_name = qk::quark "iconName";
is_active = qk::quark "isActive";
is_set = qk::quark "isSet";
is_vertical = qk::quark "isVertical";
label = qk::quark "label";
length = qk::quark "length";
padx = qk::quark "padx";
pady = qk::quark "pady";
ready_color = qk::quark "readyColor";
relief = qk::quark "relief";
repeat_delay = qk::quark "repeatDelay";
repeat_interval = qk::quark "repeatInterval";
rounded = qk::quark "rounded";
scale = qk::quark "scale";
select_color = qk::quark "selectColor";
select_background = qk::quark "selectBackground";
select_border_thickness = qk::quark "selectBorderWidth";
select_foreground = qk::quark "selectForeground";
show_value = qk::quark "showValue";
state = qk::quark "state";
text = qk::quark "text";
thumb_length = qk::quark "thumbLength";
tick_interval = qk::quark "tickInterval";
tile = qk::quark "tile";
title = qk::quark "title";
to_value = qk::quark "toValue";
type = qk::quark "type";
valign = qk::quark "valign";
width = qk::quark "width";
Type
= STRING
| INT
| FLOAT
| BOOL
| FONT
| COLOR
| COLOR_SPEC
| TILE
| CURSOR
| HALIGN
| VALIGN
| RELIEF
| ARROW_DIR
| GRAVITY
;
Value
= STRING_VAL String
| INT_VAL Int
| FLOAT_VAL Float
| BOOL_VAL Bool
#
| FONT_VAL xc::Font
| COLOR_VAL xc::Rgb
| COLOR_SPEC_VAL xc::Color_Spec
| TILE_VAL xc::Ro_Pixmap
| CURSOR_VAL xc::Xcursor
#
| HALIGN_VAL wt::Horizontal_Alignment
| VALIGN_VAL wt::Vertical_Alignment
| ARROW_DIR_VAL wt::Arrow_Direction
| GRAVITY_VAL wt::Gravity
#
| RELIEF_VAL d3::Relief
| NO_VAL
;
no_val = NO_VAL;
Context
=
{ screen: xc::Screen,
tilef: String -> xc::Ro_Pixmap
};
exception BAD_ATTRIBUTE_VALUE;
exception NO_CONVERSION;
fun same_type (STRING_VAL _, STRING) => TRUE;
same_type (INT_VAL _, INT) => TRUE;
same_type (FLOAT_VAL _, FLOAT) => TRUE;
same_type (BOOL_VAL _, BOOL) => TRUE;
same_type (FONT_VAL _, FONT) => TRUE;
same_type (COLOR_VAL _, COLOR) => TRUE;
same_type (TILE_VAL _, TILE) => TRUE;
same_type (CURSOR_VAL _, CURSOR) => TRUE;
same_type (HALIGN_VAL _, HALIGN) => TRUE;
same_type (VALIGN_VAL _, VALIGN) => TRUE;
same_type (RELIEF_VAL _, RELIEF) => TRUE;
same_type _ => FALSE;
end;
fun same_value (STRING_VAL a, STRING_VAL b) => a == b;
same_value (INT_VAL a, INT_VAL b) => a == b;
same_value (FLOAT_VAL a, FLOAT_VAL b) => f8b::(====)(a, b);
same_value (BOOL_VAL a, BOOL_VAL b) => a == b;
same_value (FONT_VAL a, FONT_VAL b) => xc::same_font (a, b);
same_value (COLOR_VAL a, COLOR_VAL b) => xc::same_rgb (a, b);
same_value (TILE_VAL a, TILE_VAL b) => xc::same_ro_pixmap (a, b);
same_value (CURSOR_VAL a, CURSOR_VAL b) => xc::same_cursor (a, b);
same_value (HALIGN_VAL a, HALIGN_VAL b) => a == b;
same_value (VALIGN_VAL a, VALIGN_VAL b) => a == b;
same_value (RELIEF_VAL a, RELIEF_VAL b) => a == b;
#
same_value (NO_VAL, NO_VAL) => TRUE;
same_value _ => FALSE;
end;
# strip leading and trailing whitespace from a string.
fun sstrip s
=
ss::drop_suffix char::is_space (ss::drop_prefix char::is_space (ss::from_string s));
fun strip s
=
ss::to_string (sstrip s);
fun skip_ws s
=
ss::drop_prefix char::is_space (ss::from_string s);
fun convert_bool s
=
case (strip s)
#
("true" | "yes" | "Yes" | "on" | "On" ) => TRUE;
("false" | "no" | "No" | "off" | "Off") => FALSE;
_ => raise exception BAD_ATTRIBUTE_VALUE;
esac;
fun convert_int s
=
{ s = number_string::skip_ws ss::getc (ss::from_string s);
start = if (char::is_digit (ss::get (s, 0)) ) 0; else 1; fi;
rad = if (ss::get (s, start) == '0')
#
case (ss::get (s, start+1))
#
('X' | 'x') => number_string::HEX;
_ => number_string::OCTAL;
esac;
else
number_string::DECIMAL;
fi;
case (int::scan rad ss::getc s)
#
NULL => raise exception BAD_ATTRIBUTE_VALUE;
THE (n, _) => n;
esac;
}
except
_ = raise exception BAD_ATTRIBUTE_VALUE;
fun convert_float s
=
(#1 (the (f8b::scan ss::getc (skip_ws s))))
except
_ = raise exception BAD_ATTRIBUTE_VALUE;
# Convert a string to a color_spec
#
fun convert_color_spec s
=
{ s = sstrip s;
fun split n
=
{ fun extract i
=
#1 (the (unt::scan number_string::HEX ss::getc (ss::make_slice (s, i, THE n))));
xc::CMS_RGB {
red => extract 1,
green => extract (1+n),
blue => extract (1+n+n)
};
};
if (ss::get (s, 0) == '#')
#
case (ss::size s)
#
4 => split 1; # "#RGB"
7 => split 2; # "#RRGGBB"
10 => split 3; # "#RRRGGGBBB"
13 => split 4; # "#RRRRGGGGBBBB"
_ => raise exception BAD_ATTRIBUTE_VALUE;
esac;
else
xc::CMS_NAME (ss::to_string s);
fi;
}
except
_ => raise exception BAD_ATTRIBUTE_VALUE; end ;
# Convert between strings and horizontal alignments:
#
fun convert_horizontal_alignment "left" => wt::HLEFT;
convert_horizontal_alignment "right" => wt::HRIGHT;
convert_horizontal_alignment "center" => wt::HCENTER;
convert_horizontal_alignment _ => wt::HCENTER;
end; # ???
fun halign_to_string wt::HLEFT => "left";
halign_to_string wt::HRIGHT => "right";
halign_to_string wt::HCENTER => "center";
end;
# Convert between strings and vertical alignments:
#
fun convert_vertical_alignment "top" => wt::VTOP;
convert_vertical_alignment "bottom" => wt::VBOTTOM;
convert_vertical_alignment "center" => wt::VCENTER;
convert_vertical_alignment _ => wt::VCENTER;
end; # ???
fun valign_to_string wt::VTOP => "top";
valign_to_string wt::VBOTTOM => "bottom";
valign_to_string wt::VCENTER => "center";
end;
# Convert strings and reliefs:
#
fun convert_relief "raised" => d3::RAISED;
convert_relief "ridge" => d3::RIDGE;
convert_relief "groove" => d3::GROOVE;
convert_relief "flat" => d3::FLAT;
convert_relief "sunken" => d3::SUNKEN;
convert_relief _ => d3::SUNKEN;
end; # ???
fun relief_to_string d3::FLAT => "flat";
relief_to_string d3::RAISED => "raised";
relief_to_string d3::RIDGE => "ridge";
relief_to_string d3::GROOVE => "groove";
relief_to_string d3::SUNKEN => "sunken";
end;
# Convert strings and arrow directions:
#
fun convert_arrow_direction "down" => wt::ARROW_DOWN;
convert_arrow_direction "left" => wt::ARROW_LEFT;
convert_arrow_direction "right" => wt::ARROW_RIGHT;
convert_arrow_direction _ => wt::ARROW_UP;
end; # ???
fun arrow_dir_to_string wt::ARROW_DOWN => "down";
arrow_dir_to_string wt::ARROW_LEFT => "left";
arrow_dir_to_string wt::ARROW_RIGHT => "right";
arrow_dir_to_string wt::ARROW_UP => "up";
end;
# Convert strings and gravity:
#
fun convert_gravity "north" => wt::NORTH;
convert_gravity "south" => wt::SOUTH;
convert_gravity "east" => wt::EAST;
convert_gravity "west" => wt::WEST;
convert_gravity "northeast" => wt::NORTH_EAST;
convert_gravity "northwest" => wt::NORTH_WEST;
convert_gravity "southeast" => wt::SOUTH_EAST;
convert_gravity "southwest" => wt::SOUTH_WEST;
convert_gravity _ => wt::CENTER;
end; # ???
fun gravity_to_string wt::NORTH => "north";
gravity_to_string wt::SOUTH => "south";
gravity_to_string wt::EAST => "east";
gravity_to_string wt::WEST => "west";
gravity_to_string wt::NORTH_EAST => "northeast";
gravity_to_string wt::NORTH_WEST => "northwest";
gravity_to_string wt::SOUTH_EAST => "southeast";
gravity_to_string wt::SOUTH_WEST => "southwest";
gravity_to_string wt::CENTER => "center";
end;
color_format = f::sprintf' "#%04x%04x%04x";
fun color_to_string rgb
=
{ my (red, blue, green)
=
xc::rgb_to_unts rgb;
color_format
[
f::UNT red,
f::UNT green,
f::UNT blue
];
};
fun color_spec_to_string (xc::CMS_RGB { red, green, blue })
=>
color_format
[
f::UNT red,
f::UNT green,
f::UNT blue
];
color_spec_to_string _
=>
raise exception NO_CONVERSION;
end;
# Convert a string to a Standard_Xcursor - FIX: better encoding XXX SUCKO FIXME
#
fun convert_standard_cursor name
=
case (strip name)
#
"x_cursor" => xrs::x_cursor;
"arrow" => xrs::arrow;
"based_arrow_down" => xrs::based_arrow_down;
"based_arrow_up" => xrs::based_arrow_up;
"boat" => xrs::boat;
"bogosity" => xrs::bogosity;
"bottom_left_corner" => xrs::bottom_left_corner;
"bottom_right_corner" => xrs::bottom_right_corner;
"bottom_side" => xrs::bottom_side;
"bottom_tee" => xrs::bottom_tee;
"box_spiral" => xrs::box_spiral;
"center_ptr" => xrs::center_ptr;
"circle" => xrs::circle;
"clock" => xrs::clock;
"coffee_mug" => xrs::coffee_mug;
"cross" => xrs::cross;
"cross_reverse" => xrs::cross_reverse;
"crosshair" => xrs::crosshair;
"diamond_cross" => xrs::diamond_cross;
"dot" => xrs::dot;
"dotbox" => xrs::dotbox;
"double_arrow" => xrs::double_arrow;
"draft_large" => xrs::draft_large;
"draft_small" => xrs::draft_small;
"draped_box" => xrs::draped_box;
"exchange" => xrs::exchange;
"fleur" => xrs::fleur;
"gobbler" => xrs::gobbler;
"gumby" => xrs::gumby;
"hand1" => xrs::hand1;
"hand2" => xrs::hand2;
"heart" => xrs::heart;
"icon" => xrs::icon;
"iron_cross" => xrs::iron_cross;
"left_ptr" => xrs::left_ptr;
"left_side" => xrs::left_side;
"left_tee" => xrs::left_tee;
"leftbutton" => xrs::leftbutton;
"ll_angle" => xrs::ll_angle;
"lr_angle" => xrs::lr_angle;
"man" => xrs::man;
"middlebutton" => xrs::middlebutton;
"mouse" => xrs::mouse;
"pencil" => xrs::pencil;
"pirate" => xrs::pirate;
"plus" => xrs::plus;
"question_arrow" => xrs::question_arrow;
"right_ptr" => xrs::right_ptr;
"right_side" => xrs::right_side;
"right_tee" => xrs::right_tee;
"rightbutton" => xrs::rightbutton;
"rtl_logo" => xrs::rtl_logo;
"sailboat" => xrs::sailboat;
"sb_down_arrow" => xrs::sb_down_arrow;
"sb_h_double_arrow" => xrs::sb_h_double_arrow;
"sb_left_arrow" => xrs::sb_left_arrow;
"sb_right_arrow" => xrs::sb_right_arrow;
"sb_up_arrow" => xrs::sb_up_arrow;
"sb_v_double_arrow" => xrs::sb_v_double_arrow;
"shuttle" => xrs::shuttle;
"sizing" => xrs::sizing;
"spider" => xrs::spider;
"spraycan" => xrs::spraycan;
"star" => xrs::star;
"target" => xrs::target;
"tcross" => xrs::tcross;
"top_left_arrow" => xrs::top_left_arrow;
"top_left_corner" => xrs::top_left_corner;
"top_right_corner" => xrs::top_right_corner;
"top_side" => xrs::top_side;
"top_tee" => xrs::top_tee;
"trek" => xrs::trek;
"ul_angle" => xrs::ul_angle;
"umbrella" => xrs::umbrella;
"ur_angle" => xrs::ur_angle;
"watch" => xrs::watch;
"xterm" => xrs::xterm;
#
_ => raise exception BAD_ATTRIBUTE_VALUE;
esac;
# Convert a string to the specified kind of style attribute value;
# This raises BAD_ATTRIBUTE_VALUE if the string has the wrong format.
#
fun convert_string { screen, tilef }
=
convert
where
open_font = xc::find_else_open_font # Misnomer -- this version always opens font via round-trip to X server. But this is old code due to be discarded soon.
(xc::xsession_of_screen screen);
fun convert_tile s = (tilef (strip s)) except _ = raise exception BAD_ATTRIBUTE_VALUE;
fun convert_font s = (open_font (strip s)) except _ = raise exception BAD_ATTRIBUTE_VALUE;
fun convert_cursor s
=
(xc::get_standard_xcursor (xc::xsession_of_screen screen) (convert_standard_cursor s))
except
_ = raise exception BAD_ATTRIBUTE_VALUE;
fun convert (value, STRING) => STRING_VAL value;
convert (value, INT) => INT_VAL (convert_int value);
convert (value, FLOAT) => FLOAT_VAL (convert_float value);
convert (value, BOOL) => BOOL_VAL (convert_bool value);
convert (value, FONT) => FONT_VAL (convert_font value);
convert (value, COLOR) => COLOR_VAL (xc::get_color (convert_color_spec value));
convert (value, COLOR_SPEC) => COLOR_SPEC_VAL (convert_color_spec value);
convert (value, TILE) => TILE_VAL (convert_tile value);
convert (value, CURSOR) => CURSOR_VAL (convert_cursor value);
convert (value, HALIGN) => HALIGN_VAL (convert_horizontal_alignment value);
convert (value, VALIGN) => VALIGN_VAL (convert_vertical_alignment value);
convert (value, RELIEF) => RELIEF_VAL (convert_relief value);
convert (value, ARROW_DIR) => ARROW_DIR_VAL (convert_arrow_direction value);
convert (value, GRAVITY) => GRAVITY_VAL (convert_gravity value);
end;
end; # convert_string
fun make_string (STRING_VAL s) => s;
make_string (INT_VAL i) => int::to_string i;
make_string (FLOAT_VAL r) => f8b::format (number_string::SCI (THE 6)) r;
make_string (BOOL_VAL b) => bool::to_string b;
make_string (COLOR_VAL c) => color_to_string c;
make_string (COLOR_SPEC_VAL c) => color_spec_to_string c;
make_string (HALIGN_VAL a) => halign_to_string a;
make_string (VALIGN_VAL a) => valign_to_string a;
make_string (RELIEF_VAL r) => relief_to_string r;
make_string (ARROW_DIR_VAL a) => arrow_dir_to_string a;
make_string (GRAVITY_VAL a) => gravity_to_string a;
make_string (NO_VAL) => "NoValue";
make_string _ => raise exception NO_CONVERSION;
end;
fun convert_attribute_value (context as { screen, ... } )
=
convert
where
convert_string = convert_string context;
fun convert_cursor sc
=
(xc::get_standard_xcursor (xc::xsession_of_screen screen) sc)
except
_ = raise exception BAD_ATTRIBUTE_VALUE;
fun convert (STRING_VAL s, type) => convert_string (s, type);
convert (v, STRING) => STRING_VAL (make_string v);
convert (v as INT_VAL _, INT) => v;
convert (INT_VAL i, FLOAT) => FLOAT_VAL (float i);
convert (v as FLOAT_VAL _, FLOAT) => v;
convert (FLOAT_VAL r, INT) => INT_VAL (f8b::truncate r); # ???
convert (v as BOOL_VAL _, BOOL) => v;
convert (v as FONT_VAL _, FONT) => v;
convert (v as COLOR_VAL _, COLOR) => v;
convert (v as TILE_VAL _, TILE) => v;
convert (v as CURSOR_VAL _, CURSOR) => v;
convert (v as HALIGN_VAL _, HALIGN) => v;
convert (v as VALIGN_VAL _, VALIGN) => v;
convert (v as RELIEF_VAL _, RELIEF) => v;
#
convert (v as ARROW_DIR_VAL _, ARROW_DIR) => v;
convert (v as GRAVITY_VAL _, GRAVITY) => v;
convert (v as COLOR_SPEC_VAL _, COLOR_SPEC) => v;
convert (COLOR_SPEC_VAL c, COLOR) => COLOR_VAL (xc::get_color c);
convert _ => raise exception NO_CONVERSION;
end;
end; # CvtAttrValue
fun get_int (INT_VAL i) => i; get_int _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_float (FLOAT_VAL r) => r; get_float _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_bool (BOOL_VAL b) => b; get_bool _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_string (STRING_VAL s) => s; get_string _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_font (FONT_VAL f) => f; get_font _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_tile (TILE_VAL x) => x; get_tile _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_cursor (CURSOR_VAL x) => x; get_cursor _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_halign (HALIGN_VAL x) => x; get_halign _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_valign (VALIGN_VAL x) => x; get_valign _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_relief (RELIEF_VAL x) => x; get_relief _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_color (COLOR_VAL c) => c; get_color _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_color_spec (COLOR_SPEC_VAL c) => c; get_color_spec _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_arrow_dir (ARROW_DIR_VAL x) => x; get_arrow_dir _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun get_gravity (GRAVITY_VAL x) => x; get_gravity _ => raise exception BAD_ATTRIBUTE_VALUE; end;
fun wrap f v
=
(THE (f v))
except
_ = NULL;
get_int_opt = wrap get_int;
get_float_opt = wrap get_float;
get_bool_opt = wrap get_bool;
get_string_opt = wrap get_string;
get_color_opt = wrap get_color;
get_font_opt = wrap get_font;
get_tile_opt = wrap get_tile;
get_cursor_opt = wrap get_cursor;
get_halign_opt = wrap get_halign;
get_valign_opt = wrap get_valign;
get_relief_opt = wrap get_relief;
get_color_spec_opt = wrap get_color_spec;
get_arrow_dir_opt = wrap get_arrow_dir;
get_gravity_opt = wrap get_gravity;
}; # Attributes
end;