/* ***********************************************************************
# Compiled by:
# src/lib/tk/src/tk.sublib Project: sml/Tk: an Tk Toolkit for sml
Author: Stefan Westmeier, University of Bremen
$Date: 2001/03/30 13:39:22 $
$Revision: 3.0 $
Purpose of this file: Operations on Widgets Contents
*********************************************************************** */
package widget_ops
: (weak) Widget_Ops # Widget_Ops is from src/lib/tk/src/widget_ops.api{
include package basic_tk_types;
include package basic_utilities;
# get_marked_text has to look for
# the actual text in case of an
# TEXT_ENTRY- TEXT_WIDGET or LIST_BOX widget
#
fun get_marked_text wid (m1, m2) =
{
gvf = com::read_tcl_val;
ip = paths::get_int_path_gui wid;
w = widget_tree::get_widget_guipath ip;
case w
TEXT_ENTRY _ =>
gvf((paths::get_tcl_path_gui ip) + " get");
# Absolute Notloesung. Unklar wie man Selektionen findet !!!
TEXT_WIDGET _ =>
{ com::put_line (com::write_mto_tcl + " [" + (paths::get_tcl_path_gui ip) +
".txt get " + (mark::show m1) + " " +
(mark::show m2) + "]") ;
com::get_line_m();};
LIST_BOX _ =>
{
my (mt1, _)=string_util::break_at_dot (mark::show m1);
my (mt2, _)=string_util::break_at_dot (mark::show m2);
gvf((paths::get_tcl_path_gui ip) + ".box get " + mt1 + " " + mt2);
};
_ => config::get_livetext_text w;
esac;
};
fun get_text wid = get_marked_text wid (MARK (0, 0), MARK_END);
fun get_widget_selections wid =
{
gvf = com::read_tcl_val;
ip = paths::get_int_path_gui wid;
w = widget_tree::get_widget_guipath ip;
fun make_mark str =
{ my (x, y)= string_util::break_at_dot str;
MARK (string_util::to_int x, string_util::to_int y);
};
fun group [] => [];
group (a . []) => []; # hmmm ... ?
group (a . b . s) => (a, b) . group (s); end;
case w
TEXT_WIDGET _ =>
{
s = gvf((paths::get_tcl_path_gui ip) + ".txt tag ranges sel");
group (map make_mark (string_util::words s));
};
LIST_BOX _ =>
{
t = gvf((paths::get_tcl_path_gui ip) + ".box curselection");
if (t=="" )
[];
else
[(MARK (string_util::to_int t, 0), MARK_END)];fi;
};
# TEXT_ENTRY ?????????
_ => []; esac;
};
fun get_selection_window_and_widget ()
=
{
gvf = com::read_tcl_val;
t = gvf("selection own");
if (t == "" ) NULL; else THE (paths::get_int_path_from_tcl_path_gui t);fi;
};
# get_cursor_mark has to look for the actual cursor position in Listboxes
# And TextWidgets
fun get_cursor_mark wid
=
{
gvf = com::read_tcl_val;
ip = paths::get_int_path_gui wid;
w = widget_tree::get_widget_guipath ip;
case w
TEXT_WIDGET _
=>
{
t = gvf((paths::get_tcl_path_gui ip) + ".txt index insert");
my (m1, m2)= string_util::break_at_dot t;
MARK (string_util::to_int m1, string_util::to_int m2);
};
LIST_BOX _
=>
{
t = gvf((paths::get_tcl_path_gui ip) + ".box curselection");
# debug::print 2 ("SelectCursor: t= >" + t + "<")
if ( t == "" ) raise exception WIDGET "widget_ops::get_cursor_mark: no selection";
else MARK (null_or::the_else (int::from_string t, 0), 0);fi;
};
_ # TEXT_ENTRY ?????????
=>
MARK (0, 0); esac;
};
fun get_tcl_text_widget_read_only_flag wid
=
{
widg = widget_tree::get_widget_gui wid;
tp = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;
if ((get_widget_type widg) == TEXT_WIDGET_TYPE)
case (com::read_tcl_val (tp + ".txt cget -state"))
"normal" => FALSE; # TextWidStateNormal
"disabled" => TRUE; # TextWidStateDisabled
esac;
else
raise exception WIDGET "widget_ops::get_tcl_text_widget_read_only_flag: applied to non-text_widget";
fi;
};
fun set_tcl_text_widget_read_only_flag wid st
=
{
widg = widget_tree::get_widget_gui wid;
tp = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;
if ( (get_widget_type widg) == TEXT_WIDGET_TYPE )
com::put_tcl_cmd (tp + ".txt configure -state " + (config::show_state st));
else
raise exception WIDGET "widget_ops::setTextWidState: applied to non-text_widget";fi;
};
/* wrapper for functions doing things to text widgets: if it is read-only
* we need to temporarily make it writable, otherwise nothing happens
* (and the programmer is mightily confused).
*/
fun do_text_wid f wid
=
{ old_st = get_tcl_text_widget_read_only_flag wid;
set_tcl_text_widget_read_only_flag wid FALSE;
f wid;
if old_st set_tcl_text_widget_read_only_flag wid old_st; fi;
};
fun clear_livetext wid
=
{
widg = widget_tree::get_widget_gui wid;
anl = live_text::get_livetext_text_items (text_item::get_text_widget_livetext widg);
do_text_wid (\\ w=> { apply (\\ an => text_item_tree::delete w
(text_item::get_text_item_id an); end ) anl;
widget_tree::clear_text w;}; end ) wid;
};
fun replace_livetext wid ats
=
{ clear_livetext wid;
do_text_wid (\\ w=> { widget_tree::set_text_end w (live_text::get_livetext_text ats);
apply (\\ an => text_item_tree::add w an; end )
(live_text::get_livetext_text_items ats);}; end ) wid;};
fun delete_marked_livetext wid marks =
# TBD: delete text_items as well !!
do_text_wid (\\ w=> widget_tree::delete_text w marks; end ) wid;
# insert annotated text into text widgets
fun ins_at wid at (r, c) =
{ str = live_text::get_livetext_text at;
# have to adjust text_items of the AT we want to insert
annos = live_text::adjust_marks { rows=>r, cols=>c }
(live_text::get_livetext_text_items at);
do_text_wid (\\ w=> { widget_tree::set_text w str (MARK (r, c));
apply (text_item_tree::add w) annos;}; end ) wid;
};
fun insert_livetext_at_mark wid at (MARK (r, c))
=>
ins_at wid at (r, c);
insert_livetext_at_mark wid at (MARK_TO_END r)
=>
ins_at wid at (r, 0); # WRONG!
insert_livetext_at_mark wid at (MARK_END)
=>
/* Very inefficient as it counts the length of the whole text-- yuck:
*/
{ my (r, c)= live_text::livetext_length (get_text wid);
ins_at wid at (r, c);
}; end;
fun append_livetext wid at
=
insert_livetext_at_mark wid at MARK_END;
# No check that this variable is really defined!!!
fun get_var_value var
=
com::read_tcl_val("global " + var + "; set " + var);
fun set_var_value var value
=
ignore (com::read_tcl_val("global " + var + "; set " + var + " " + value));
fun make_and_pop_up_window widg index co
=
{
winid = paths::make_widget_id();
frmid = paths::make_widget_id();
frm = FRAME {
widget_id => frmid,
subwidgets => PACKED [widg],
packing_hints => [],
traits => [],
event_callbacks => []
};
wid = get_widget_id widg;
window::open_w (winid, [], PACKED [frm], [], \\()=> (); end );
widget_tree::pop_up_menu wid index co;
};
fun set_scale_value wid r
=
{ widg = widget_tree::get_widget_gui wid;
tp = (paths::get_tcl_path_gui o paths::get_int_path_gui) wid;
com::put_tcl_cmd (tp + " set " + config::show_real r);
};
};