## scrollable-string-editor.pkg
#
# String edit widget with arrow buttons for scrolling.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib### "You are what you read."
###
### -- Bert Schoenfeld
stipulate
include threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package mr = xevent_mail_router; # xevent_mail_router is from src/lib/x-kit/widget/basic/xevent-mail-router.pkg package pb = pushbuttons; # pushbuttons is from src/lib/x-kit/widget/leaf/pushbuttons.pkg package se = string_editor; # string_editor is from src/lib/x-kit/widget/text/string-editor.pkg package wg = widget; # widget is from src/lib/x-kit/widget/basic/widget.pkg package xg = xgeometry; # xgeometry is from src/lib/std/2d/xgeometry.pkgherein
package scrollable_string_editor
: (weak) Scrollable_String_Editor # Scrollable_String_Editor is from src/lib/x-kit/widget/text/scrollable-string-editor.api {
Scrollable_String_Editor
=
SCROLLABLE_STRING_EDITOR
( wg::Widget,
(Void -> String),
(String -> Void)
);
fun make_scrollable_string_editor root_window (arg as { foreground, background, initial_string, min_length } )
=
{ screen = wg::screen_of root_window;
stredit = se::make_string_editor root_window arg;
cwidget = se::as_widget stredit;
cbnds = wg::size_preference_thunk_of cwidget;
c_realize = wg::realize_fn cwidget;
my { row_preference, ... } = cbnds ();
naty = wg::preferred_length row_preference;
shift = se::shift_window stredit;
lefta = pb::make_arrow_pushbutton root_window { direction=>pb::ARROW_LEFT, size=>naty, foreground, background };
leftw = pb::as_widget lefta;
lbnds = wg::size_preference_thunk_of leftw;
l_realize = wg::realize_fn leftw;
leftevt = pb::button_transition'_of lefta;
righta = pb::make_arrow_pushbutton root_window { direction=>pb::ARROW_RIGHT, size=>naty, foreground, background };
rightw = pb::as_widget righta;
rbnds = wg::size_preference_thunk_of rightw;
r_realize = wg::realize_fn rightw;
rightevt = pb::button_transition'_of righta;
fun sizer ()
=
{ (cbnds ()) -> { col_preference, row_preference };
wg::make_tight_size_preference
( (wg::preferred_length col_preference) + 4,
(wg::preferred_length row_preference)
);
};
fun wont_fit (xg::SIZE { wide, ... } )
=
{ (cbnds ()) -> { col_preference, ... };
wg::preferred_length col_preference > wide;
};
fun layout (size as xg::SIZE { wide, high } )
=
{ my { col_preference, ... } = cbnds ();
my { col_preference=>ldim, ... } = lbnds ();
my { col_preference=>rdim, ... } = rbnds ();
lx = wg::preferred_length ldim;
rx = wg::preferred_length rdim;
if (wg::preferred_length col_preference <= wide)
#
(
FALSE,
xg::BOX { col=>0, row=>0, wide=>lx, high },
xg::BOX { col=>0, row=>0, wide, high },
xg::BOX { col=>wide-rx, row=>0, wide=>rx, high }
);
else
( TRUE,
xg::BOX { col=>0, row=>0, wide=>lx, high },
xg::BOX { col=>lx, row=>0, wide=>int::max (1, wide-lx-rx), high },
xg::BOX { col=>wide-rx, row=>0, wide=>rx, high }
);
fi;
};
fun listener mailop action
=
{ timeout' = timeout_in' (time::from_float_seconds 0.05);
fun down_loop ()
=
{ do_mailop timeout';
case (do_mailop mailop)
pb::BUTTON_DOWN _
=>
{ action ();
down_loop ();
};
_ => ();
esac;
};
fun loop ()
=
loop { do_mailop mailop;
action ();
down_loop ();
};
loop ();
};
pr = fn _ = ();
fun realize_scrollable_string_editor { kidplug, window, window_size }
=
{ my lo as (active, lrect, crect, rrect)
=
layout window_size;
lwin = wg::make_child_window (window, lrect, wg::args_of leftw);
cwin = wg::make_child_window (window, crect, wg::args_of cwidget);
rwin = wg::make_child_window (window, rrect, wg::args_of rightw);
my { kidplug => lkidplug, momplug => lmomplug as xc::MOMPLUG { from_kid'=>lco, ... } } = xc::make_widget_cable ();
my { kidplug => ckidplug, momplug => cmomplug as xc::MOMPLUG { from_kid'=>cco, ... } } = xc::make_widget_cable ();
my { kidplug => rkidplug, momplug => rmomplug as xc::MOMPLUG { from_kid'=>rco, ... } } = xc::make_widget_cable ();
(xc::make_widget_cable ())
->
{ kidplug => my_kidplug,
momplug => my_momplug
};
my_kidplug
->
xc::KIDPLUG { from_other' => myci,
from_mouse' => mym,
from_keyboard' => myk,
...
};
router = mr::make_xevent_mail_router (kidplug, my_momplug, []);
childco = wg::wrap_queue cco;
fun do_layout ((a, lr, cr, rr), (a', lr', cr', rr'))
=
{ if (a' != a)
#
if a'
xc::show_window lwin;
xc::show_window rwin;
else
xc::hide_window lwin;
xc::hide_window rwin;
fi;
fi;
if (lr' != lr) xc::move_and_resize_window lwin lr'; fi;
if (cr' != cr) pr "resize stredit\n"; xc::move_and_resize_window cwin cr'; fi;
if (rr' != rr) xc::move_and_resize_window rwin rr'; fi;
};
fun main window_size lo
=
loop lo
where
fun loop lo
=
loop (
select [
myci ==> .{ do_mom (xc::envelope_contents #mailop, lo); },
myk ==> .{ do_keyboard (xc::envelope_contents #mailop, lo); },
mym ==> .{ do_mouse (xc::envelope_contents #mailop, lo); },
childco ==> .{ handle_c (#mailop, lo); },
lco ==> (fn _ = lo),
rco ==> (fn _ = lo)
]
)
where
fun do_mom (xc::ETC_RESIZE (xg::BOX { col, row, wide, high } ), lo)
=>
{ window_size' = xg::SIZE { wide, high };
lo' = layout window_size';
do_layout (lo, lo');
main window_size' lo';
};
do_mom (_, lo)
=>
lo;
end;
fun handle_c (xc::REQ_RESIZE, lo as (a, _, _, _))
=>
{ pr "resize plea\n";
a' = wont_fit window_size;
if (a == a' )
#
lo;
else
lo' = layout window_size;
pr "newlayout\n";
do_layout (lo, lo');
lo';
fi;
};
handle_c (xc::REQ_DESTRUCTION, lo)
=>
lo;
end;
fun do_keyboard ((xc::KEY_PRESS _), lo)
=>
{ (file::print " [field-edit received KEY_PRESS]\n"); lo; };
do_keyboard ((_), lo)
=>
lo;
end;
fun do_mouse ((xc::MOUSE_ENTER _), lo)
=>
{ a = xc::grab_keyboard cwin;
# (file::print (" [field-edit received xc::MOUSE_ENTER: "$(int::to_string (a))$"]\n"))
lo;
};
do_mouse ((_), lo)
=>
lo;
end;
end;
end;
mr::add_child router (lwin, lmomplug);
mr::add_child router (cwin, cmomplug);
mr::add_child router (rwin, rmomplug);
make_thread "scrollable_string_editor left" .{ listener leftevt .{ shift -1; }; };
make_thread "scrollable_string_editor right" .{ listener rightevt .{ shift 1; }; };
make_thread "scrollable_string_editor" .{
#
main window_size (active, lrect, crect, rrect);
();
};
l_realize { kidplug=>lkidplug, window=>lwin, window_size=>xg::box::size lrect };
c_realize { kidplug=>ckidplug, window=>cwin, window_size=>xg::box::size crect };
r_realize { kidplug=>rkidplug, window=>rwin, window_size=>xg::box::size rrect };
if active
#
xc::show_window lwin;
xc::show_window rwin;
fi;
xc::show_window cwin;
};
SCROLLABLE_STRING_EDITOR
(
wg::make_widget
{
root_window,
args=> fn () = { background => NULL },
size_preference_thunk_of => sizer,
realize => realize_scrollable_string_editor
},
fn () = se::get_string stredit,
se::set_string stredit
);
};
fun as_widget (SCROLLABLE_STRING_EDITOR (w, _, _)) = w;
fun get_string (SCROLLABLE_STRING_EDITOR (w, g, _)) = g ();
fun set_string (SCROLLABLE_STRING_EDITOR (_, _, s)) = s;
}; # scrollable_string_editor
end;