/* Project: Tk: A Tk Toolkit for Mythryl
* Author: Stefan Westmeier, University of Bremen
* Purpose of this file: Tag example
*/
# Compiled by:
# src/lib/tk/src/tests+examples/sources.sublib### "I've seen things you people wouldn't believe.
###
### "Attack ships on fire off the shoulder of Orion.
###
### "I watched C-beams glitter in the dark near the Tannhauser gate.
###
### "All those moments will be lost in time, like tears in rain.
###
###
### "Time to die."
###
### -- Bladerunner
package tag_ex
: (weak) api { go: Void -> String; }
{
include package basic_utilities;
include package tk;
# Main Window
#
main_window_id = make_tagged_window_id("hauptfenster");
t1 = make_tagged_widget_id "t1";
fat = make_text_item_id();
my menu: Widget
=
{
quit = make_simple_callback (\\ () = close_window main_window_id);
fun del_but tn
=
make_simple_callback (\\ () = delete_text_item t1 tn);
fun del_tag tn
=
make_callback (\\ (_: Tk_Event) = delete_text_item t1 tn);
fun col_tag tn co
=
make_callback (\\ (_: Tk_Event) = add_text_item_traits
t1 tn [BACKGROUND co]);
new_but
=
\\ ()
=
{ tn = make_text_item_id ();
TEXT_ITEM_WIDGET {
text_item_id => tn,
mark => MARK_END,
subwidgets =>
PACKED [
BUTTON {
widget_id => make_widget_id(),
packing_hints => [FILL ONLY_X],
traits => [TEXT "Delete Me",
CALLBACK (del_but tn)],
event_callbacks => []
}
],
traits => [],
event_callbacks => []
};
};
new_tag = \\ () =
{
tn = make_text_item_id();
TEXT_ITEM_TAG { text_item_id => tn,
marks => [(MARK (2, 11), MARK_TO_END 2)],
traits => [BACKGROUND BLUE, BORDER_THICKNESS 2, RELIEF RAISED],
event_callbacks => [ EVENT_CALLBACK (BUTTON_PRESS NULL, del_tag tn),
EVENT_CALLBACK (ENTER, (col_tag tn RED)),
EVENT_CALLBACK (LEAVE, (col_tag tn BLUE))] };
};
new_sel = \\ () =
{
tn = make_text_item_id();
TEXT_ITEM_TAG { text_item_id=>tn,
marks=> read_selection t1,
traits => [BACKGROUND GREEN,
BORDER_THICKNESS 2, RELIEF RAISED],
event_callbacks=> [EVENT_CALLBACK (BUTTON_PRESS NULL, del_tag tn),
EVENT_CALLBACK (ENTER, (col_tag tn RED)),
EVENT_CALLBACK (LEAVE, (col_tag tn GREEN))] };
};
add_but = make_simple_callback (\\ () = add_text_item
t1
(new_but()));
add_tag = make_simple_callback (\\ () = add_text_item
t1
(new_tag()));
add_sel = make_simple_callback (\\ () = add_text_item
t1
(new_sel()));
fun print_tags wid
=
\\ ()
=
{
widg = get_widget wid;
ans = get_text_widget_text_items widg;
ans' = list::filter (\\ TEXT_ITEM_TAG _ => TRUE; _ => FALSE; end ) ans;
fun prt_an_pos an
=
{
tn = get_text_item_id an;
ms = get_tcl_text_item_marks wid tn;
file::write (file::stderr, "Tag: " $ make_text_item_id_string (tn) $ "\n");
file::write (file::stderr, "\t" $ show_mark_list (ms) $ "\n");
};
apply prt_an_pos ans';
};
FRAME { widget_id=>make_widget_id(),
subwidgets => PACKED [
MENU_BUTTON { widget_id=>make_widget_id(),
mitems => [MENU_COMMAND([TEXT "Quit", CALLBACK quit])],
packing_hints => [PACK_AT LEFT],
traits => [TEXT "File", TEAR_OFF FALSE],
event_callbacks => [] },
MENU_BUTTON { widget_id=>make_widget_id(),
mitems => [MENU_COMMAND([TEXT "Add Button", CALLBACK add_but]),
MENU_COMMAND([TEXT "Add Tag", CALLBACK add_tag]),
MENU_COMMAND([TEXT "Conv Sel", CALLBACK add_sel]),
MENU_COMMAND([TEXT "Clear Text",
CALLBACK (make_simple_callback (\\ ()=> clear_text t1; end ))]),
MENU_COMMAND([TEXT "Insert New Text",
CALLBACK (make_simple_callback (\\ ()=> insert_text_end t1
("No never, no never no more\n"$
"will I trust the Elves of Dunsinore\n"); end ))]),
MENU_SEPARATOR,
MENU_COMMAND([TEXT "Print Tags",
CALLBACK (make_simple_callback (print_tags t1))])
],
packing_hints => [PACK_AT LEFT],
traits => [TEXT "Item", TEAR_OFF FALSE],
event_callbacks => [] },
MENU_BUTTON
{ widget_id=>make_widget_id(),
mitems => [ MENU_CHECKBUTTON [TEXT "Writeable",
VARIABLE "TWState",
CALLBACK (make_simple_callback (\\ ()= case (get_tcl_var_value "TWState")
"0" => set_tcl_text_widget_read_only_flag t1 TRUE;
_ => set_tcl_text_widget_read_only_flag t1 FALSE;
esac
)
)
],
MENU_SEPARATOR,
MENU_COMMAND([TEXT "Clear Text+Annotations",
CALLBACK (make_simple_callback (\\ ()=> clear_livetext t1; end ))]),
MENU_COMMAND([TEXT "Replace Text+Annotations",
CALLBACK (make_simple_callback (\\ ()=> {
t = "Neuer Text\n";
tg = TEXT_ITEM_TAG { text_item_id=>fat,
marks => [(MARK (1, 0), MARK (1, 5))],
traits=> [BACKGROUND RED, BORDER_THICKNESS 2, RELIEF RAISED], event_callbacks=> [] };
replace_livetext t1 (LIVE_TEXT { len=>NULL, str=>t, text_items => [tg] } );
}; end
))])
],
packing_hints => [PACK_AT LEFT], traits => [TEXT "Widget State", TEAR_OFF FALSE], event_callbacks => [] }
],
packing_hints => [FILL ONLY_X],
traits => [RELIEF RAISED, BORDER_THICKNESS 2],
event_callbacks => [] };
};
my board: Widget =
{
t = "\nDies ist ein Tag-Test\n\nUnd noch ein Test ...\n";
tg = TEXT_ITEM_TAG { text_item_id=> fat, marks=> [(MARK (2, 9), MARK (2, 21))],
traits=> [BACKGROUND RED, BORDER_THICKNESS 2, RELIEF RAISED],
event_callbacks => [EVENT_CALLBACK (BUTTON_PRESS NULL, make_callback (\\ _ =>
{ file::write (file::stdout,
"Button press in annotation\n");
add_text_item_traits t1 fat [BACKGROUND BLUE];}; end )),
EVENT_CALLBACK (BUTTON_RELEASE NULL, make_callback (\\ _ =>
{ file::write (file::stdout, "Button release in annotation\n");
add_text_item_traits t1 fat [BACKGROUND RED];}; end )),
EVENT_CALLBACK (ENTER, make_callback (\\ _ =>
file::write (file::stdout, "text_item entered\n"); end ))] };
wg1 =
TEXT_ITEM_WIDGET { text_item_id => make_text_item_id(),
mark => MARK (3, 0),
traits => [],
event_callbacks => [],
subwidgets => PACKED [
BUTTON {
widget_id => make_widget_id(),
packing_hints => [FILL ONLY_X],
traits => [TEXT "Push Me",
CALLBACK null_callback],
event_callbacks => []
},
BUTTON {
widget_id => make_widget_id(),
packing_hints => [FILL ONLY_X],
traits => [TEXT "Push Me",
CALLBACK null_callback],
event_callbacks => []
}
]
};
wg2
=
TEXT_ITEM_WIDGET {
text_item_id => make_text_item_id(),
mark => MARK (3, 0),
traits => [],
event_callbacks => [],
subwidgets => PACKED [
BUTTON {
widget_id => make_widget_id(),
packing_hints => [FILL ONLY_X],
traits => [TEXT "Push Me",
CALLBACK
(make_simple_callback
(\\ () => (); end ))],
event_callbacks => []
}
]
};
at = LIVE_TEXT { len=>NULL, str=>t, text_items => [tg, wg1, wg2] };
FRAME {
widget_id => make_widget_id (),
subwidgets => PACKED [
TEXT_WIDGET {
widget_id => t1,
scrollbars => AT_LEFT,
live_text=>at,
packing_hints => [],
traits => [ACTIVE FALSE],
event_callbacks => []
}
],
packing_hints => [PACK_AT LEFT, FILL ONLY_X],
event_callbacks => [],
traits => [ WIDTH 200,
HEIGHT 200,
RELIEF RAISED,
BORDER_THICKNESS 2
]
};
};
my
area = [ menu, board ];
my
act = make_simple_callback (\\ () => (); end );
my
initwin = [ make_window {
window_id => main_window_id,
traits => [WINDOW_TITLE "Tag Example"],
subwidgets => PACKED area,
event_callbacks => [],
init => act
}
];
my
go = \\ () = start_tcl_and_trap_tcl_exceptions initwin;
};