## enter_windows.pkg
## Author: bu/kol/cxl
## (C) 1997-99, Bremen Institute for Safe Systems, Universitaet Bremen
# Compiled by:
# src/lib/tk/src/toolkit/sources.sublib### "For a successful technology,
### reality must take precedence
### over public relations, for
### Nature cannot be fooled."
###
### -- Richard P. Feynman
# ***************************************************************************
# Windows to enter substitutions or related data structures.
# **************************************************************************
api Subst_Window {
# a substitution is a list [(p_i, str_i)] of pairs of strings,
# where p_i is the "parameter names" and str_i its value.
#
# In the following, new creates a new list of substitutions,
# ie. str_i are (initially) empty, whereas edit takes an existing
# substitution. The "title" below is the window title.
new: { title: String,
width: Int,
params: List( String ),
cc: List ((String, String)) -> Void } -> Void;
edit: { title: String,
width: Int,
subst: List ((String, String)),
cc: List ((String, String)) -> Void } -> Void;
};
package subst_window: (weak) Subst_Window { # Subst_Window is from src/lib/tk/src/toolkit/enter_windows.pkg include package tk;
/* These lines, copied from util_window here, should go into some general
* configuration thingy */
msg_font = NORMAL_FONT [];
msg_width = 40;
button_relief = RAISED;
button_width = 5;
button_font = SANS_SERIF [];
enter_text_font = TYPEWRITER [];
fun upto (from, to)
=
if (to < from ) [];
else from . upto (from+1, to);fi;
fun do_subst (width, sep, wintitle, subst, cc)
=
{ # Width of variable entry boxes:
# max. length of a var. name + 2
#
var_width = (fold_backward
(\\ ((a, _), m)
=
if (size a > m)
size a;
else m; fi
)
0
subst
)
+ 2;
# Some widget ids:
#
fun lhs_wid_id (w, n) = make_sub_widget_id (w, "substLhs" $ int::to_string n);
fun rhs_wid_id (w, n) = make_sub_widget_id (w, "substRhs" $ int::to_string n);
fun subst_frm_id w = make_sub_widget_id (w, "substFrm");
fun add_button_id w = make_sub_widget_id (w, "substBttn");
fun cls_button_id w = make_sub_widget_id (w, "substCls");
fun zip_it s
=
paired_lists::zip (upto (1, length s), s);
# Entry box for one substitution:
#
fun one_entry w (n, (par, str))
=
FRAME {
widget_id => make_widget_id(),
packing_hints => [PACK_AT TOP],
traits => [],
event_callbacks => [],
subwidgets => PACKED [
TEXT_ENTRY {
widget_id => lhs_wid_id (w, n),
packing_hints => [PACK_AT LEFT],
event_callbacks => [],
traits => [ WIDTH var_width,
FONT enter_text_font
]
},
LABEL {
widget_id => make_widget_id (),
packing_hints => [ PACK_AT LEFT ],
traits => [TEXT sep],
event_callbacks => []
},
TEXT_ENTRY {
widget_id => rhs_wid_id (w, n),
packing_hints => [PACK_AT RIGHT],
event_callbacks => [],
traits => [ WIDTH width,
FONT enter_text_font
]
}
]
};
# frame with all substitutions.
# Needs to be one frame so we
# can add new subst-entry boxes:
fun all_substs w substs
=
FRAME {
widget_id => (subst_frm_id w),
subwidgets => PACKED (map (one_entry w) (zip_it subst)),
packing_hints => [PACK_AT TOP],
traits => [],
event_callbacks => []
};
# Close window, read values, continue with cc:
fun close_subst (window, wid, n)
=
{ fun get_sub n = (get_tcl_text (lhs_wid_id (wid, n)),
get_tcl_text (rhs_wid_id (wid, n)));
subst = list::filter (\\ (p, _)=> not (p==""); end )
(map get_sub (upto (1, n)));
close_window window;
cc subst;
};
/* add another entry box.
* Note reconfiguration of the commands
* bound to the add-button and the close-button
*/
fun add_subst (window, wid, n)
=
{ add_trait (add_button_id wid)
[CALLBACK (make_simple_callback (\\()=> add_subst (window, wid, n+1); end ))];
add_trait (cls_button_id wid)
[CALLBACK (make_simple_callback (\\()=> close_subst (window, wid, n+1); end ))];
add_widget window (subst_frm_id wid) (one_entry wid (n+1, ("", "")));
};
fun subst_frame (window, wid)
=
FRAME {
widget_id => make_widget_id(),
packing_hints => [PACK_AT TOP, FILL ONLY_X],
traits => [],
event_callbacks => [],
subwidgets => PACKED [ all_substs wid subst,
BUTTON {
widget_id => (add_button_id wid),
packing_hints => [PACK_AT TOP, FILL ONLY_X],
event_callbacks => [],
traits => [ WIDTH var_width,
TEXT "Add Parameter", FONT button_font,
CALLBACK (make_simple_callback (\\()=>
add_subst (window, wid, length subst); end ))
]
}
]
};
fun button_frm (window, wid)
=
FRAME {
widget_id => make_widget_id(),
packing_hints => [FILL ONLY_X, PACK_AT BOTTOM],
traits => [],
event_callbacks => [],
subwidgets
=>
PACKED [
BUTTON {
widget_id => (cls_button_id wid),
packing_hints => [PACK_AT RIGHT],
event_callbacks => [],
traits => [ TEXT "OK",
WIDTH button_width,
FONT button_font,
CALLBACK (make_simple_callback (\\()=> close_subst (window, wid,
length subst); end ))
]
},
BUTTON {
widget_id => make_widget_id (),
packing_hints => [PACK_AT LEFT],
event_callbacks => [],
traits => [ TEXT "Cancel",
WIDTH button_width,
FONT button_font,
CALLBACK (make_simple_callback (\\()= close_window window))
]
}
]
};
# initializiation function
fun fill_subst wid (n, (p, str))
=
{ insert_text_end (lhs_wid_id (wid, n)) p;
insert_text_end (rhs_wid_id (wid, n)) str
;};
my
window = make_window_id (); my
wid = make_widget_id ();
open_window (
make_window {
window_id => window,
traits => [WINDOW_TITLE wintitle],
event_callbacks => [],
subwidgets => PACKED [subst_frame (window, wid),
button_frm (window, wid)],
init => (\\ ()=> apply (fill_subst wid) (zip_it subst); end )
}
);
};
fun new { title, params, width, cc }
=
do_subst (width, " |-> ", title, map (\\ str = (str, "")) params, cc);
fun edit { title, subst, width, cc }
=
do_subst (width, " |-> ", title, subst, cc);
};