# show-graph-app.pkg
#
# One way to run this app from the base-directory commandline is:
#
# linux% my
# eval: make "src/lib/x-kit/tut/show-graph/show-graph-app.lib";
# eval: show_graph_app::do_it ("src/lib/x-kit/tut/show-graph/data/nodes.dot", "");
# Compiled by:
# src/lib/x-kit/tut/show-graph/show-graph-app.lib # scrollable_graphviz_widget is from src/lib/x-kit/widget/old/fancy/graphviz/scrollable-graphviz-widget.pkg # dot_graphtree is from src/lib/std/dot/dot-graphtree.pkg # dotgraph_to_planargraph is from src/lib/std/dot/dotgraph-to-planargraph.pkg# 2009-12-28 CrT:
# Wrapped below code in package main { ... }
# just to make it more compilable -- the SML/NJ
# code has the functions bare:
#
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package mps = microthread_preemptive_scheduler; # microthread_preemptive_scheduler is from src/lib/src/lib/thread-kit/src/core-thread-kit/microthread-preemptive-scheduler.pkg #
package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg #
package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg package top = hostwindow; # hostwindow is from src/lib/x-kit/widget/old/basic/hostwindow.pkg #
package d2p = dotgraph_to_planargraph; # dotgraph_to_planargraph is from src/lib/std/dot/dotgraph-to-planargraph.pkg package dg = dot_graphtree; # dot_graphtree is from src/lib/std/dot/dot-graphtree.pkg package gv = scrollable_graphviz_widget; # scrollable_graphviz_widget is from src/lib/x-kit/widget/old/fancy/graphviz/scrollable-graphviz-widget.pkg package pg = planar_graphtree; # planar_graphtree is from src/lib/std/dot/planar-graphtree.pkg package ffc = font_family_cache; # font_family_cache is from src/lib/x-kit/widget/old/fancy/graphviz/font-family-cache.pkg #
package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
logfile = "show-graph.trace.log";
logging = logger::make_logtree_leaf { parent => xlogger::xkit_logging, name => "show_graph_app::logging", default => FALSE };
to_log = xtr::log_if logging 0; # Conditionally write strings to logging.log or whatever.
#
# To debug via tracelogging, annotate the code with lines like
#
# to_log {. sprintf "foo/top: bar d=%d" bar; };
#
# and then set write_tracelog = TRUE; below.
herein
package show_graph_app {
#
write_tracelog = TRUE;
log_if = xtr::log_if fil::compiler_logging 0; # Purely for debug narration.
fun set_up_logging ()
=
{ # Open tracelog file and select logging level.
# We don't need to truncate any existing file
# because that is already done by the logic in
# src/lib/std/src/posix/winix-text-file-io-driver-for-posix--premicrothread.pkg #
include package logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg #
# set_logger_to (xtr::log_TO_FILE logfile); # Commented out because for the moment I'd rather have the results in xkit-tut-unit-test.log -- 2012-03-08 CrT
# enable fil::all_logging; # Gross overkill.
};
stipulate
selfcheck_tests_passed = REF 0;
selfcheck_tests_failed = REF 0;
herein
run_selfcheck = REF FALSE;
app_task = REF (NULL: Null_Or( Apptask ));
fun reset_global_mutable_state () # Reset above state variables to load-time values.
= # This will be needed if (say) we get run multiple times interactively without being reloaded.
{ run_selfcheck := FALSE;
#
app_task := NULL;
#
selfcheck_tests_passed := 0;
selfcheck_tests_failed := 0;
};
fun test_passed () = { selfcheck_tests_passed := *selfcheck_tests_passed + 1;
log_if {. "show-graph-app.pkg: test_passed() called."; }; };
fun test_failed () = { selfcheck_tests_failed := *selfcheck_tests_failed + 1;
log_if {. "show-graph-app.pkg: test_failed() called."; }; };
#
fun assert bool = if bool test_passed ();
else test_failed ();
fi;
#
fun test_stats ()
=
{ passed => *selfcheck_tests_passed,
failed => *selfcheck_tests_failed
};
fun kill_show_graph_app ()
=
{
kill_task { success => TRUE, task => (the *app_task) };
};
fun wait_for_app_task_done ()
=
{
task = the *app_task;
#
task_finished' = task_done__mailop task;
block_until_mailop_fires task_finished';
assert (get_task's_state task == state::SUCCESS);
};
end;
stipulate
# Thread to exercise the app by simulating user
# mouseclicks and verifying their effects:
#
fun make_selfcheck_thread
{
# hostwindow,
# widgettree,
xsession
}
=
xtr::make_thread "show-graph-app selfcheck" selfcheck
where
fun selfcheck ()
=
{
log_if {. "show-graph-app.pkg: selfcheck: AAA"; };
# Wait until the widgettree is realized and running:
#
# get (wg::get_''gui_startup_complete''_oneshot_of widgettree); # This idea doesn't seem to be working at present anyhow.
# sleep_for 2.0;
# window = wg::window_of widgettree;
# Fetch from X server the center pixels
# over which we are about to draw:
#
# (midwindow window) -> (_, window_midbox);
#
# antedraw_window_image
# =
# xc::make_clientside_pixmap_from_window (window_midbox, window);
# Re-fetch center pixels, verify
# that new result differs from original result.
#
# This is dreadfully sloppy, but seems to be
# good enough to verify that there is something
# happening in the window:
#
# postdraw_window_image
# =
# xc::make_clientside_pixmap_from_window (window_midbox, window);
#
# assert (not (xc::same_cs_pixmap (antedraw_window_image, postdraw_window_image)));
log_if {. "show-graph-app.pkg: selfcheck: sleeping 2 seconds"; };
sleep_for 2.0; # Just to let the user watch it.
# All done -- shut everything down:
#
log_if {. "show-graph-app.pkg: selfcheck: closing session"; };
xc::close_xsession xsession;
sleep_for 0.2; # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.
kill_show_graph_app ();
# log_if {. "show-graph-app.pkg: selfcheck: shutting down thread scheduler"; };
# shut_down_thread_scheduler winix__premicrothread::process::success; # This is what we did pre-6.3.
log_if {. "show-graph-app.pkg: selfcheck: Done."; };
();
};
end; # fun make_selfcheck_thread
fun view_graph (font_family_cache, root_window, graph)
=
{
title = "Show-Graph: " + (dg::graph_name graph);
newvg = d2p::convert_dotgraph_to_planargraph graph;
view = gv::make_scrollable_graphviz_widget (font_family_cache, root_window) newvg;
hostwindow
=
top::make_hostwindow
( gv::as_widget view,
NULL,
{ window_name => THE title,
icon_name => THE title
}
);
top::start_widgettree_running_in_hostwindow hostwindow;
};
fun uncaught_exception_shutdown (m, s)
=
{ fil::print (cat ["uncaught exception ", m, " \"", s, "\"\n"] );
log_if {. sprintf "show-graph-app.pkg/uncaught_exception_shutdown %s %s SHUTTING DOWN! DIVE! DIVE! DIVE!" m s; };
# Presumably we should be doing the following two lines here,
# but first we need how to get access to xsession at this point: # XXX BUGGO FIXME
#
# xc::close_xsession xsession;
# sleep_for 0.2; # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.
kill_show_graph_app ();
# shut_down_thread_scheduler winix__premicrothread::process::success; # We used to do this pre-6.3
};
# This is the toplevel application thread:
#
fun read_eval_print_thread (dotfile, xdisplay, xauthentication)
=
{
root_window = wg::make_root_window (xdisplay, xauthentication);
screen = wg::screen_of root_window;
xsession = xc::xsession_of_screen screen;
font_family_cache = ffc::make_font_family_cache root_window ffc::default_font_family;
graph = dg::read_graph dotfile;
view_graph = view_graph (font_family_cache, root_window, graph);
fun run_user_command tokens
=
do tokens
where
fun do ["quit"] => { xc::close_xsession xsession;
sleep_for 0.2; # I think close_xsession returns before everything has shut down. Need something cleaner here. XXX SUCKO FIXME.
kill_show_graph_app ();
};
do [] => ();
do _ => print "???\n";
end;
end;
tokenize
=
string::tokens char::is_space;
# Read one line of user input from stdin:
#
fun read_user_line () # This fn is a quick 2010-07-06 CrT hack,
= # because fil::read_line doesn't block. (Which must be a bug...?!)
{
log_if {. sprintf "show-graph-app.pkg/read_user_line/111"; };
string = fil::read fil::stdin # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg except x as io_exceptions::IO { name, op, cause }
=
{ msg = exceptions::exception_message x;
log_if {. sprintf "show-graph-app.pkg/read_user_line/111.5 %s" msg; };
# XXX BUGGO FIXME this is an appallingly ugly thing to be
# doing -- I/we need to fix the underlying interruped-system-call
# nonsense Real Soon Now.
#
=~ = regex::(=~);
#
if (msg =~ ./Interrupted system call/)
log_if {. sprintf "show-graph-app.pkg/read_user_line/111.6: Retrying interrupted system call"; };
read_user_line ();
else
log_if {. sprintf "show-graph-app.pkg/read_user_line/111.6: Re-raising exception"; };
raise exception x;
fi;
};
log_if {. sprintf "show-graph-app.pkg/read_user_line/222"; };
# If we have a full line return it,
# otherwise read rest of line:
#
len = size string;
log_if {. sprintf "show-graph-app.pkg/read_user_line/333"; };
#
if (len > 0 and
string::get_byte_as_char (string, len - 1) == '\n')
#
log_if {. sprintf "show-graph-app.pkg/read_user_line/444"; };
string;
else
log_if {. sprintf "show-graph-app.pkg/read_user_line/555"; };
string + read_user_line ();
fi;
};
fun read_eval_print_loop ()
=
if *run_selfcheck
#
# No need for read-eval-print in selfcheck mode:
#
for (;;) {
#
sleep_for 1.0;
};
else
print "show-graph-app command interpreter.\n";
print "Currently only supported command is 'quit'.\n";
#
for (;;) {
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/AAA"; };
print ">> ";
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/BBB"; };
fil::flush fil::stdout;
#
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/CCC"; };
user_input_line = read_user_line();
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/DDD"; };
tokenized_line = tokenize user_input_line;
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/EEE"; };
#
run_user_command tokenized_line;
log_if {. sprintf "show-graph-app.pkg/read_eval_print_loop/FFF"; };
};
fi;
if *run_selfcheck
#
make_selfcheck_thread
{
# hostwindow,
# widgettree => low::as_widget layout,
xsession
};
();
fi;
read_eval_print_loop ();
}
except (dg::GRAPHTREE_ERROR s) => uncaught_exception_shutdown ("dot_graphtree::GRAPHTREE_ERROR", s);
(pg::GRAPHTREE_ERROR s) => uncaught_exception_shutdown ("planar_graphtree::GRAPH", s);
(xc::XSERVER_CONNECT_ERROR s) => uncaught_exception_shutdown ("xclient::XSERVER_CONNECT_ERROR", s);
#
e => {
fun f (s, l)
= " ** "
! s
! "\n"
! l
;
trace_back
=
list::fold_backward f [] (lib7::exception_history e);
log_if {. sprintf "show-graph-app.pkg/read_eval_print_thread: Unexpected exception %s %s: SHUTTING DOWN." (exception_name e) (cat trace_back); };
kill_show_graph_app ();
# shut_down_thread_scheduler winix__premicrothread::process::failure;
};
end;
# This is used only by the 'generate_executable' call below:
#
fun generate_executable_main dotfile _
=
{
display_name = ""; # Should maybe create a way to pass this in.
my ( xdisplay, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xc::Xauthentication) # Typically from ~/.Xauthority
)
=
xc::get_xdisplay_string_and_xauthentication
#
case display_name
#
"" => NULL;
_ => THE display_name;
esac;
root_window = wg::make_root_window (xdisplay, xauthentication);
font_family_cache = ffc::make_font_family_cache root_window ffc::default_font_family;
graph = dg::read_graph dotfile;
view_graph (font_family_cache, root_window, graph);
0;
}
except (dg::GRAPHTREE_ERROR s) => { uncaught_exception_shutdown ("dot_graphtree::GRAPH", s); 1; };
(pg::GRAPHTREE_ERROR s) => { uncaught_exception_shutdown ("planar_graphtree::GRAPH", s); 1; };
(xc::XSERVER_CONNECT_ERROR s) => { uncaught_exception_shutdown ("xclient::XSERVER_CONNECT_ERROR", s); 1; };
#
e => { printf "show-graph-app.pkg/generate_executable_main: Unexpected exception %s: SHUTTING DOWN." (exception_name e);
log_if {. sprintf "show-graph-app.pkg/generate_executable_main: Unexpected exception %s: SHUTTING DOWN." (exception_name e); };
kill_show_graph_app ();
winix__premicrothread::process::failure;
# shut_down_thread_scheduler winix__premicrothread::process::failure;
};
end;
herein
fun start_up_show_graph_app_threads (dotfile, display_name)
=
{
display_name' = case display_name "" => NULL;
_ => THE display_name;
esac;
(xc::get_xdisplay_string_and_xauthentication display_name')
->
( xdisplay, # Typically from $DISPLAY environment variable.
xauthentication: Null_Or(xc::Xauthentication) # Typically from ~/.Xauthority
);
read_eval_print_thread (dotfile, xdisplay, xauthentication);
();
};
fun set_up_show_graph_app_task (dotfile, display_name)
=
# Here we arrange that all the threads
# for the application run as a task "show graph app",
# so that later we can shut them all down with
# a simple kill_task(). We explicitly create one
# root thread within the task; the rest then implicitly
# inherit task membership:
#
{
show_graph_app_task = make_task "show graph app" [];
app_task := THE show_graph_app_task;
#
xtr::make_thread' [ THREAD_NAME "show graph app",
THREAD_TASK show_graph_app_task
]
start_up_show_graph_app_threads
(dotfile, display_name);
();
};
fun do_it (dotfile, display_name)
=
{ flags = []; # Often can be set via do_it arg in other apps.
xlogger::init flags;
if write_tracelog
#
set_up_logging ();
fi;
set_up_show_graph_app_task (dotfile, display_name);
wait_for_app_task_done ();
();
}; # fun do_it
fun demo display_name
=
{ winix__premicrothread::file::change_directory "../data";
do_it ("nodes.dot", display_name);
};
fun generate_executable executable_name dotfile # mygraph.dot ascii file defining graph to display, e.g data/nodes.dot
=
spawn_to_disk( executable_name, generate_executable_main dotfile, THE (time::from_milliseconds 20) );
fun selfcheck ()
=
{
reset_global_mutable_state (); # Don't depend on load-time state initialization -- we might get run multiple times interactively, say.
run_selfcheck := TRUE;
do_it ("src/lib/x-kit/tut/show-graph/data/nodes.dot", "");
test_stats ();
};
end; # stipulate
};
end;