## show-graph.pkg
#
# A graph-viewer widget for ML code.
# Compiled by:
#
src/lib/x-kit/widget/xkit-widget.sublibstipulate
include package 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 fil = file__premicrothread; # file__premicrothread is from
src/lib/std/src/posix/file--premicrothread.pkg package lw = line_of_widgets; # line_of_widgets is from
src/lib/x-kit/widget/old/layout/line-of-widgets.pkg package pb = pushbuttons; # pushbuttons is from
src/lib/x-kit/widget/old/leaf/pushbuttons.pkg #
package v = ml_source_code_viewer; # ml_source_code_viewer is from
src/lib/x-kit/widget/old/fancy/graphviz/text/ml-source-code-viewer.pkg #
package load = load_file_g( fil ); # load_file_g is from
src/lib/x-kit/widget/old/fancy/graphviz/text/load-file-g.pkg #
package xtr = xlogger; # xlogger is from
src/lib/x-kit/xclient/src/stuff/xlogger.pkgherein
package show_graph: Show_Graph { # Show_Graph is from
src/lib/x-kit/widget/old/fancy/graphviz/text/show-graph.api fun open_viewer root_window { file, module, loc, range }
=
{
# my _ = cio::print (format::format "open_viewer: file = %s, module = %s, loc = %d\n" [
# format::STR file, format::STR module, format::INT loc])
oneshot = make_oneshot_maildrop ();
xtr::make_thread "ml_viewer open_viewer" {.
#
put_in_oneshot (oneshot, load::load_file (file, range));
};
stipulate
find_else_open_font = xc::find_else_open_font (widget::xsession_of root_window);
herein
font1 = find_else_open_font "-*-courier-medium-r-*-*-20-*-*-*-*-*-*-*";
font2 = find_else_open_font "-*-courier-medium-o-*-*-20-*-*-*-*-*-*-*";
font3 = find_else_open_font "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*";
end;
viewer = ml_source_code_viewer::make_viewer root_window
{
src => get_from_oneshot oneshot,
font => font1,
#
background => xc::CMS_NAME "wheat1",
#
comm_face => v::FACE { font=>THE font2, color => THE (xc::CMS_NAME "red" ) },
kw_face => v::FACE { font=>THE font3, color => THE (xc::CMS_NAME "black") },
sym_face => v::FACE { font=>THE font3, color => THE (xc::CMS_NAME "black") },
id_face => v::FACE { font=>NULL, color => THE (xc::CMS_NAME "blue" ) }
};
init_loc = case range
NULL => loc - 1;
THE { first, last } => loc - first;
esac;
(widget::filter_other (scroll_viewer::make_viewer root_window (viewer, init_loc)))
->
(widget, mailop);
quit_btn = pb::make_text_pushbutton root_window
{
rounded => TRUE,
label => "Close view",
background => NULL,
foreground => NULL
};
widget' = lw::as_widget
(lw::make_line_of_widgets root_window
(lw::VT_CENTER
[
lw::HZ_CENTER
[
lw::SPACER { min_size=>2, best_size=>2, max_size=>THE 2 },
lw::VT_CENTER
[
lw::SPACER { min_size=>2, best_size=>2, max_size=>THE 2 },
lw::WIDGET (pb::as_widget quit_btn),
lw::SPACER { min_size=>2, best_size=>2, max_size=>THE 2 }
],
lw::SPACER { min_size=>1, best_size=>1000, max_size=>NULL }
],
lw::WIDGET (divider::make_horizontal_divider root_window { color=>NULL, width=>1 } ),
lw::WIDGET widget
]
)
);
hostwindow
=
hostwindow::make_hostwindow
( widget',
NULL,
{ window_name => THE ("ML-viewer: " + file),
icon_name => THE "ML-viewer"
}
);
fun cmd_monitor ()
=
loop ()
where
(block_until_mailop_fires mailop)
->
(cmd', cmd_slot);
quit' = pb::button_transition'_of quit_btn;
fun do_cmd envelope
=
{ case (xc::get_contents_of_envelope envelope)
#
xc::ETC_OWN_DEATH => hostwindow::destroy hostwindow;
_ => ();
esac;
put_in_mailslot (cmd_slot, envelope);
};
fun do_quit (pb::BUTTON_UP _) => hostwindow::destroy hostwindow;
do_quit _ => ();
end;
fun loop ()
=
for (;;) {
#
do_one_mailop [
#
cmd' ==> do_cmd,
quit' ==> do_quit
];
};
end;
hostwindow::start_widgettree_running_in_hostwindow hostwindow;
xtr::make_thread "ml_viewer" cmd_monitor;
();
}; # fun open_viewer
}; # package show_graph
end;