## pushbuttons.pkg
#
# Common buttons.
#
# Compare to:
# src/lib/x-kit/widget/old/leaf/toggleswitches.pkg# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "If it keeps up, man will atrophy all
### his limbs but the push-button finger."
###
### -- Frank Lloyd Wright, 1953
stipulate
package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package wa = widget_attribute_old; # widget_attribute_old is from src/lib/x-kit/widget/old/lib/widget-attribute-old.pkg package wy = widget_style_old; # widget_style_old is from src/lib/x-kit/widget/old/lib/widget-style-old.pkgherein
package pushbuttons
: (weak) Pushbuttons # Pushbuttons is from src/lib/x-kit/widget/old/leaf/pushbuttons.api {
# The Pushbuttons api does swallow
# pretty much this entire package:
#
include package button_type; # button_type is from src/lib/x-kit/widget/old/leaf/button-type.pkg stipulate
package w: (weak) api {
Arrow_Direction
= ARROW_UP
| ARROW_DOWN
| ARROW_LEFT
| ARROW_RIGHT;
}
=
widget_types;
herein
include package w;
end;
# pushbutton_behavior_g is from src/lib/x-kit/widget/old/leaf/pushbutton-behavior-g.pkg package arrow_button = pushbutton_behavior_g( arrowbutton_look ); # arrowbutton_look is from src/lib/x-kit/widget/old/leaf/arrowbutton-look.pkg package text_button = pushbutton_behavior_g( textbutton_look ); # textbutton_look is from src/lib/x-kit/widget/old/leaf/textbutton-look.pkg package label_button = pushbutton_behavior_g( labelbutton_look ); # labelbutton_look is from src/lib/x-kit/widget/old/leaf/labelbutton-look.pkg make_arrow_pushbutton' = arrow_button::make_pushbutton;
make_text_pushbutton' = text_button::make_pushbutton;
make_label_pushbutton' = label_button::make_pushbutton;
make_arrow_pushbutton_with_click_callback' = arrow_button::make_pushbutton_with_click_callback;
make_text_pushbutton_with_click_callback' = text_button::make_pushbutton_with_click_callback;
make_label_pushbutton_with_click_callback' = label_button::make_pushbutton_with_click_callback;
fun make_text_pushbutton root { rounded, label, foreground, background }
=
{
name = wy::make_view { name=> wy::style_name ["textButton"],
aliases => [] };
args = [ (wa::rounded, wa::BOOL_VAL rounded),
(wa::label, wa::STRING_VAL label)
];
args = case foreground
THE c => (wa::foreground, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
args = case background
THE c => (wa::background, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
make_text_pushbutton' (root, (name, wg::style_of root), args);
};
fun make_text_pushbutton_with_click_callback root { click_callback, rounded, label, foreground, background }
=
{
name = wy::make_view { name => wy::style_name ["textCommand"],
aliases => []
};
args = [ (wa::rounded, wa::BOOL_VAL rounded),
(wa::label, wa::STRING_VAL label )
];
args = case foreground
THE c => (wa::foreground, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
args = case background
THE c => (wa::background, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
make_text_pushbutton_with_click_callback' (root, (name, wg::style_of root), args) click_callback;
};
fun make_arrow_pushbutton root { direction, size, foreground, background }
=
{ name = wy::make_view { name=> wy::style_name ["arrowButton"],
aliases => [] };
args = [ (wa::width, wa::INT_VAL size),
(wa::arrow_dir, wa::ARROW_DIR_VAL direction)
];
args = case foreground
#
THE c => (wa::foreground, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
args = case background
#
THE c => (wa::background, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
make_arrow_pushbutton' (root, (name, wg::style_of root), args);
};
fun make_arrow_pushbutton_with_click_callback root { click_callback, direction, size, foreground, background }
=
{ name = wy::make_view { name=> wy::style_name ["arrowCommand"],
aliases => []
};
args = [ (wa::width, wa::INT_VAL size),
(wa::arrow_dir, wa::ARROW_DIR_VAL direction)
];
args = case foreground
#
THE c => (wa::foreground, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
args = case background
#
THE c => (wa::background, wa::COLOR_VAL c) ! args;
NULL => args;
esac;
make_arrow_pushbutton_with_click_callback' (root, (name, wg::style_of root), args) click_callback;
};
}; # package pushbuttons
end;
## COPYRIGHT (c) 1991 by AT&T Bell Laboratories. See SMLNJ-COPYRIGHT file for details.
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.