## millboss-imp.pkg
#
# See overview comments in:
#
# src/lib/x-kit/widget/edit/millboss-imp.api# 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 ap = client_to_atom; # client_to_atom is from src/lib/x-kit/xclient/src/iccc/client-to-atom.pkg# package au = authentication; # authentication is from src/lib/x-kit/xclient/src/stuff/authentication.pkg# package cpm = cs_pixmap; # cs_pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.pkg# package cpt = cs_pixmat; # cs_pixmat is from src/lib/x-kit/xclient/src/window/cs-pixmat.pkg# package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg# package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg# package fti = font_index; # font_index is from src/lib/x-kit/xclient/src/window/font-index.pkg# package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg# package mtx = rw_matrix; # rw_matrix is from src/lib/std/src/rw-matrix.pkg# package rop = ro_pixmap; # ro_pixmap is from src/lib/x-kit/xclient/src/window/ro-pixmap.pkg# package rw = root_window; # root_window is from src/lib/x-kit/widget/lib/root-window.pkg# package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg# package sep = client_to_selection; # client_to_selection is from src/lib/x-kit/xclient/src/window/client-to-selection.pkg# package shp = shade; # shade is from src/lib/x-kit/widget/lib/shade.pkg# package sj = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg# package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg# package tr = logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg# package tsr = thread_scheduler_is_running; # thread_scheduler_is_running is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler-is-running.pkg# package u1 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg# package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg# package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg# package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg# package wi = window; # window is from src/lib/x-kit/xclient/src/window/window.pkg# package wme = window_map_event_sink; # window_map_event_sink is from src/lib/x-kit/xclient/src/window/window-map-event-sink.pkg# package wpp = client_to_window_watcher; # client_to_window_watcher is from src/lib/x-kit/xclient/src/window/client-to-window-watcher.pkg# package wy = widget_style; # widget_style is from src/lib/x-kit/widget/lib/widget-style.pkg# package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg# package xj = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg# package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg #
#
package evt = gui_event_types; # gui_event_types is from src/lib/x-kit/widget/gui/gui-event-types.pkg package gts = gui_event_to_string; # gui_event_to_string is from src/lib/x-kit/widget/gui/gui-event-to-string.pkg package gt = guiboss_types; # guiboss_types is from src/lib/x-kit/widget/gui/guiboss-types.pkg package a2r = windowsystem_to_xevent_router; # windowsystem_to_xevent_router is from src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg package gd = gui_displaylist; # gui_displaylist is from src/lib/x-kit/widget/theme/gui-displaylist.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package err = compiler::error_message; # compiler is from src/lib/core/compiler/compiler.pkg # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package ct = cutbuffer_types; # cutbuffer_types is from src/lib/x-kit/widget/edit/cutbuffer-types.pkg# package ct = gui_to_object_theme; # gui_to_object_theme is from src/lib/x-kit/widget/theme/object/gui-to-object-theme.pkg# package bt = gui_to_sprite_theme; # gui_to_sprite_theme is from src/lib/x-kit/widget/theme/sprite/gui-to-sprite-theme.pkg# package wt = widget_theme; # widget_theme is from src/lib/x-kit/widget/theme/widget/widget-theme.pkg package boi = spritespace_imp; # spritespace_imp is from src/lib/x-kit/widget/space/sprite/spritespace-imp.pkg package cai = objectspace_imp; # objectspace_imp is from src/lib/x-kit/widget/space/object/objectspace-imp.pkg package pai = widgetspace_imp; # widgetspace_imp is from src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg #
package gtg = guiboss_to_guishim; # guiboss_to_guishim is from src/lib/x-kit/widget/theme/guiboss-to-guishim.pkg package b2s = spritespace_to_sprite; # spritespace_to_sprite is from src/lib/x-kit/widget/space/sprite/spritespace-to-sprite.pkg package c2o = objectspace_to_object; # objectspace_to_object is from src/lib/x-kit/widget/space/object/objectspace-to-object.pkg package s2b = sprite_to_spritespace; # sprite_to_spritespace is from src/lib/x-kit/widget/space/sprite/sprite-to-spritespace.pkg package o2c = object_to_objectspace; # object_to_objectspace is from src/lib/x-kit/widget/space/object/object-to-objectspace.pkg package g2p = gadget_to_pixmap; # gadget_to_pixmap is from src/lib/x-kit/widget/theme/gadget-to-pixmap.pkg package im = int_red_black_map; # int_red_black_map is from src/lib/src/int-red-black-map.pkg# package is = int_red_black_set; # int_red_black_set is from src/lib/src/int-red-black-set.pkg package sm = string_map; # string_map is from src/lib/src/string-map.pkg package idm = id_map; # id_map is from src/lib/src/id-map.pkg package dxy = digraphxy; # digraphxy is from src/lib/src/digraphxy.pkg package sj = string_junk; # string_junk is from src/lib/std/src/string-junk.pkg package r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg package r64 = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package g2j = geometry2d_junk; # geometry2d_junk is from src/lib/std/2d/geometry2d-junk.pkg package mt = millboss_types; # millboss_types is from src/lib/x-kit/widget/edit/millboss-types.pkg package a2c = app_to_compileimp; # app_to_compileimp is from src/lib/x-kit/widget/edit/app-to-compileimp.pkg package e2g = millboss_to_guiboss; # millboss_to_guiboss is from src/lib/x-kit/widget/edit/millboss-to-guiboss.pkg package tbi = textmill; # textmill is from src/lib/x-kit/widget/edit/textmill.pkg package tmt = textmill_crypts; # textmill_crypts is from src/lib/x-kit/widget/edit/textmill-crypts.pkg package p2l = textpane_to_screenline; # textpane_to_screenline is from src/lib/x-kit/widget/edit/textpane-to-screenline.pkg package l2p = screenline_to_textpane; # screenline_to_textpane is from src/lib/x-kit/widget/edit/screenline-to-textpane.pkg #
package b2p = millboss_to_pane; # millboss_to_pane is from src/lib/x-kit/widget/edit/millboss-to-pane.pkg package mmo = millgraph_millout; # millgraph_millout is from src/lib/x-kit/widget/edit/millgraph-millout.pkg package fm = fundamental_mode; # fundamental_mode is from src/lib/x-kit/widget/edit/fundamental-mode.pkg package mtp = modes_to_preload; # modes_to_preload is from src/lib/x-kit/widget/edit/modes-to-preload.pkg tracefile = "widget-unit-test.trace.log";
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkg Dummy = mtp::Dummy; # We force modes-to-preload to load and it forces the stocks modes to preload.
dummy1 = make_textpane::make_pane_guiplan; # XXX SUCKO FIXME Clumsy way to force this to compile and load. Should think of a better. The problem is that it is never called directly, just backpatches itself into a refcell, so the usual dependency mechanisms do not kick in.
herein
package millboss_imp
: Millboss_Imp # Millboss_Imp is from src/lib/x-kit/widget/edit/millboss-imp.api {
Millboss_Option
#
= MICROTHREAD_NAME String #
| ID Id # Stable, unique id for imp.
;
Millboss_Arg = List(Millboss_Option); # Currently no required component.
Imports = { # Ports we use, provided by other imps.
millboss_to_guiboss: e2g::Millboss_To_Guiboss,
app_to_compileimp: a2c::App_To_Compileimp
};
#
Millgraph_Watchers # Type for tracking the set of clients subscribed to a mill for mt::Millgraph updates.
= #
mt::ipm::Map( (mt::Inport, (mt::Outport, mt::Millgraph) -> Void) ); #
Pane_Info
=
{ pane_id: Id,
pane_tag: Int, # We assign each pane a small positive Int tag to be displayed on modeline and used by "C-x o" (other_pane) in src/lib/x-kit/widget/edit/fundamental-mode.pkg mill_id: Id, # The mill displayed in the pane.
millboss_to_pane: b2p::Millboss_To_Pane # Our port to the pane.
};
Per_Mill_Wakeup_Info # Infrastructure for the wakeup service we provide to mills.
=
{
at_frame_n: Ref ( Null_Or # Call mill.wakeup once, during frame N, and pass wakeup_fn in call. NULL means this wakeup is off.
{ at_frame: Int,
wakeup_fn: mt::Wakeup_Arg -> Void
}
),
every_n_frames: Ref ( Null_Or # Call gadget.wakeup every N frames, and pass wakeup_fn in call. NULL means this wakeup is off.
{ n: Int,
next: Ref(Int),
wakeup_fn: mt::Wakeup_Arg -> Void
}
)
};
Millboss_State #
=
{ mills_by_name: Ref( sm::Map( mt::Mill_Info ) ), # All currently active mills, by name.
mills_by_id: Ref( idm::Map( mt::Mill_Info ) ), # All currently active mills, by id. Maintained by note_mill_info(). NEVER DELETED AS YET. XXX SUCKO FIXME.
mills_by_filepath: Ref( sm::Map( mt::Mill_Info ) ), # All currently active mills WHICH ARE OPEN ON A FILE, by filepath. (We expect this to typically be a full pathname like "/home/jayne/foo.txt", so as to help avoid having multiple buffers open on one file.)
#
millwatches: Ref( mt::mwm::Map (mt::Millwatch )), # Tracks which mill inports are watching which outports, maintained via note_millwatch + drop_millwatch.
#
mill_wakeups: Ref( idm::Map( Per_Mill_Wakeup_Info )), # Support for wakeme calls to mills.
current_frame_number: Ref( Int ), # " ".
#
pending_pane_mail: Ref( idm::Map( List( Crypt ) ) ), # Messages to panes which have not yet registered with us, indexed by pane_id. To preserve message order we reverse these lists before delivering them (although message order should rarely if ever matter).
panes_by_id: Ref( idm::Map( Pane_Info ) ),
#
name: Ref( String ) # Name of millboss for display purposes.
};
Me_Slot = Mailslot( { imports: Imports,
me: Millboss_State,
millboss_arg: Millboss_Arg,
run_gun': Run_Gun,
end_gun': End_Gun
}
);
Guiboss_To_Millboss
=
{ do_one_frame: Int -> Void # Called by guiboss at 50Hz to allow millboss to do periodic stuff, mostly wakeme service for mills. Int arg is current_frame_number.
};
Exports
=
{ guiboss_to_millboss: Guiboss_To_Millboss # Ports we provide for use by other imps.
};
Millboss_Egg = Void -> (Exports, (Imports, Run_Gun, End_Gun) -> Void);
Runstate = { # These values will be statically globally visible throughout the code body for the imp.
id: Id,
me: Millboss_State, #
millboss_arg: Millboss_Arg,
imports: Imports, # Imps to which we send requests.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
# #
millgraph_outport: mt::Outport, # Name of port on which we stream out millgraphs.
millgraph_millout: mt::Millout, # Port on which we stream out millgraphs.
millgraph_watchers: Ref( Millgraph_Watchers ), # Watchers of port on which we stream out millgraphs.
# #
end_gun': End_Gun # We shut down the microthread when this fires.
};
Millboss_Q = Mailqueue( Runstate -> Void );
fun make_millgraph (r: Runstate): mt::Millgraph # Construct a client-friendly representation of all running mills together with their watcher/watchee relationships.
= # Eventually we may want to keep an incrementally updated millgraph, but for now recreating it from scratch as needed is more robust and gives better code modularity.
{ digraph = dxy::empty_graph: dxy::Graph( mt::Millgraph_Node, Void ); # Set up to create the digraph of which mill inports are watching which mill outports.
#
mill_nodes = idm::empty: idm::Map(dxy::Node(mt::Millgraph_Node)); # Maps Id values to digraph::Node values to map mill values into digraph land. This map contains one Mill_Info value for each running mill.
inport_nodes = mt::ipm::empty: mt::ipm::Map(dxy::Node(mt::Millgraph_Node)); # Maps Inport values to digraph::Node values to map inport values into digraph land. This map contains one Millin value for each input port on (any) running mill.
outport_nodes = mt::opm::empty: mt::opm::Map(dxy::Node(mt::Millgraph_Node)); # Maps Outport values to digraph::Node values to map outport values into digraph land. This map contains one Millout value for each output port on (any) running mill.
edge_tags = sm::empty: sm::Map(dxy::Tag(Void)); # Maps port_type values to digraph::Tag values to map watcher/ee values into digraph land. This map contains one Tag for each distinct port_type string in a Millin or Millout (i.e., each type of datastream in the millgraph).
my (mill_nodes, inport_nodes, outport_nodes, edge_tags, digraph) # Establish digraph nodes for all our Mill_Info, Millin and Millout values, plus the Mill_Info -> Millout and Mill_In -> Mill_Info edges.
=
add_nodes
(
idm::keyvals_list *r.me.mills_by_id,
mill_nodes,
inport_nodes,
outport_nodes,
edge_tags,
digraph
)
where
fun add_nodes ([], mill_nodes, inport_nodes, outport_nodes, edge_tags, digraph)
=>
(mill_nodes, inport_nodes, outport_nodes, edge_tags, digraph);
add_nodes
(
(mill_id: Id, mill_info: mt::Mill_Info) ! rest,
mill_nodes,
inport_nodes,
outport_nodes,
edge_tags,
digraph
)
=>
{
my (mill_nodes, millnode)
=
case (idm::get (mill_nodes, mill_id))
#
THE millnode => (mill_nodes, millnode);
NULL =>
{ mill_node = dxy::make_other_node (mt::MILL_INFO mill_info);
#
mill_nodes = idm::set (mill_nodes, mill_id, mill_node);
(mill_nodes, mill_node);
};
esac;
my (inport_nodes, edge_tags, digraph)
=
add_millins (mt::ipm::keyvals_list mill_info.millins, inport_nodes, edge_tags, digraph)
where
fun add_millins ([], inport_nodes, edge_tags, digraph)
=>
(inport_nodes, edge_tags, digraph);
add_millins ((inport: mt::Inport, millin: mt::Millin) ! rest, inport_nodes, edge_tags, digraph)
=>
{
my (inport_nodes, inportnode)
=
case (mt::ipm::get (inport_nodes, inport))
#
THE inportnode => (inport_nodes, inportnode);
NULL =>
{ inportnode = dxy::make_other_node (mt::MILLIN millin);
#
inport_nodes = mt::ipm::set (inport_nodes, inport, inportnode);
(inport_nodes, inportnode);
};
esac;
my (edge_tags, edgetag)
=
case (sm::get (edge_tags, millin.port_type))
#
THE edgetag => (edge_tags, edgetag);
NULL =>
{ edgetag = dxy::make_tag ();
#
edge_tags = sm::set (edge_tags, millin.port_type, edgetag);
(edge_tags, edgetag);
};
esac;
digraph = dxy::put_edge (digraph, (inportnode, edgetag, millnode));
add_millins (rest, inport_nodes, edge_tags, digraph);
};
end;
end;
my (outport_nodes, edge_tags, digraph)
=
add_millouts (mt::opm::keyvals_list mill_info.millouts, outport_nodes, edge_tags, digraph)
where
fun add_millouts ([], outport_nodes, edge_tags, digraph)
=>
(outport_nodes, edge_tags, digraph);
add_millouts ((outport: mt::Outport, millout: mt::Millout) ! rest, outport_nodes, edge_tags, digraph)
=>
{
my (outport_nodes, outportnode)
=
case (mt::opm::get (outport_nodes, outport))
#
THE outportnode => (outport_nodes, outportnode);
NULL =>
{ outportnode = dxy::make_other_node (mt::MILLOUT millout);
#
mt::opm::set (outport_nodes, outport, outportnode);
(outport_nodes, outportnode);
};
esac;
my (edge_tags, edgetag)
=
case (sm::get (edge_tags, millout.port_type))
#
THE edgetag => (edge_tags, edgetag);
NULL =>
{ edgetag = dxy::make_tag ();
#
sm::set (edge_tags, millout.port_type, edgetag);
(edge_tags, edgetag);
};
esac;
digraph = dxy::put_edge (digraph, (millnode, edgetag, outportnode));
add_millouts (rest, outport_nodes, edge_tags, digraph);
};
end;
end;
add_nodes (rest, mill_nodes, inport_nodes, outport_nodes, edge_tags, digraph);
};
end;
end;
digraph # Establish digraph edges for our Millout -> Millin watchee/watcher relationships.
=
add_edges (mt::mwm::vals_list *r.me.millwatches, digraph)
where
fun add_edges ([], digraph)
=>
digraph;
add_edges
(
millwatch ! rest: List( mt::Millwatch ),
digraph: dxy::Graph( mt::Millgraph_Node, Void )
)
=>
{ millwatch -> { millin, millout };
#
inport = millin.inport;
outport = millout.outport;
inportnode = case (mt::ipm::get (inport_nodes, inport))
#
THE inportnode => inportnode;
NULL => { msg = "inport not in digraph?! -- millboss_imp::make_millgraph";
log::fatal msg;
raise exception DIE msg;
};
esac;
outportnode = case (mt::opm::get (outport_nodes, outport))
#
THE outportnode => outportnode;
NULL => { msg = "outport not in digraph?! -- millboss_imp::make_millgraph";
log::fatal msg;
raise exception DIE msg;
};
esac;
port_type = case (dxy::node_other inportnode)
#
THE (mt::MILLIN millin) => millin.port_type;
_ => { msg = "millin node not mt::MILLIN? -- millboss_imp::make_millgraph";
log::fatal msg;
raise exception DIE msg;
};
esac;
edgetag = case (sm::get (edge_tags, port_type))
#
THE edgetag => edgetag;
NULL => { msg = "port_type not in edge_tags?! -- millboss_imp::make_millgraph";
log::fatal msg;
raise exception DIE msg;
};
esac;
digraph = dxy::put_edge (digraph, (outportnode, edgetag, inportnode));
add_edges (rest, digraph);
};
end;
end;
millgraph
=
{ mills_by_id => *r.me.mills_by_id,
mills_by_name => *r.me.mills_by_name,
mills_by_filepath => *r.me.mills_by_filepath,
#
digraph,
#
mill_nodes,
inport_nodes,
outport_nodes,
edge_tags
};
millgraph;
};
##############################################################
# The result of 'make_millgraph' depends on the values:
# *me.mills_by_id
# *me.millwatches
# *me.mills_by_name
# *me.mills_by_filepath
# so in order to keep millgraph watchers up-to-date,
# the code in this file NEEDS TO CALL US any after
# updating any of those values.
#
fun maybe_update_millgraph_watchers
(
r: Runstate
)
=
if (not (mt::ipm::is_empty *r.millgraph_watchers))
#
millgraph = make_millgraph r;
mt::ipm::apply tell_watcher *r.millgraph_watchers
where
fun tell_watcher
(
inport: mt::Inport, # Unique id identifying this watcher.
watcher: (mt::Outport, mt::Millgraph) -> Void #
)
=
{ outport = r.millgraph_outport;
#
watcher (outport, millgraph);
counter = r.millgraph_millout.counter; # Count messages sent through port,
counter := *counter + 1; # for debug/display purposes.
};
end;
fi;
fun tell_millgraph_watcher_current_state
(
watchfn: (mt::Outport, mt::Millgraph) -> Void,
r: Runstate
)
=
{ outport = r.millgraph_outport;
#
millgraph = make_millgraph r;
watchfn (outport, millgraph);
};
# fun tell_millgraph_watchers_current_state # Commented out because currently never used.
# (
# r: Runstate
# )
# =
# mt::ipm::apply tell_watcher *r.millgraph_watchers
# where
# fun tell_watcher
# (
# inport: mt::Inport, #
# watchfn: (mt::Outport, mt::Millgraph) -> Void #
# )
# =
# tell_millgraph_watcher_current_state (watchfn, r);
# end;
fun note_mill_info
(
runstate: Runstate,
mill_info: mt::Mill_Info
)
=
{ me = runstate.me;
#
me.mills_by_id := idm::set (*me.mills_by_id, mill_info.mill_id, mill_info);
me.mills_by_name := sm::set (*me.mills_by_name, mill_info.name, mill_info);
case mill_info.filepath
#
THE filepath
=>
{ me.mills_by_filepath
:=
sm::set (*me.mills_by_filepath, filepath, mill_info);
maybe_update_millgraph_watchers runstate;
};
NULL => ();
esac;
maybe_update_millgraph_watchers runstate;
};
fun run ( millboss_q: Millboss_Q, #
#
runstate as
{ # These values will be statically globally visible throughout the code body for the imp.
id: Id,
me: Millboss_State, #
millboss_arg: Millboss_Arg,
imports: Imports, # Imps to which we send requests.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
# #
millgraph_outport: mt::Outport, #
millgraph_millout: mt::Millout, #
millgraph_watchers: Ref( Millgraph_Watchers ), #
# #
end_gun': End_Gun #
}
)
=
{ loop ();
}
where
#
fun loop () # Outer loop for the imp.
=
{ do_one_mailop' to [
#
end_gun' ==> shut_down_millboss_imp',
take_from_mailqueue' millboss_q ==> do_millboss_plea
];
loop ();
}
where
fun do_millboss_plea thunk
=
thunk runstate;
#
fun shut_down_millboss_imp' ()
=
{
thread_exit { success => TRUE }; # Will not return.
};
end;
end;
#
fun startup (id: Id, reply_oneshot: Oneshot_Maildrop( (Me_Slot, Exports) )) () # Root fn of imp microthread. Note currying.
=
{ me_slot = make_mailslot () : Me_Slot;
#
millouts = make_millouts (millgraph_outport, *millgraph_millout);
app_to_mill # Generic interface supported by all mills. Guiboss pretends to be a kinda-sorta mill itself to allow clients to subscribe to its Millgraph Outport via standard intermill connection protocols.
=
mt::APP_TO_MILL
{
id,
millins => mt::ipm::empty,
millouts,
#
get_dirty,
pass_dirty,
get_filepath,
set_filepath,
pass_filepath,
get_name,
set_name,
pass_name,
reload_from_file,
save_to_file,
get_pane_guiplan,
pass_pane_guiplan
};
mill_to_millboss
=
mt::MILL_TO_MILLBOSS
{
id,
get_textmill,
make_textmill,
get_or_make_textmill,
get_or_make_filebuffer,
#
get_cutbuffer_contents,
set_cutbuffer_contents,
#
note_pane,
drop_pane,
mail_pane,
#
get_panes_by_id,
get_mills_by_name,
get_mills_by_id,
#
note_millwatch,
drop_millwatch,
#
wake_me,
#
app_to_mill # Include App_To_Mill as a sub-interface to allow clients to subscribe to our Millgraph Outport via standard intermill connection protocols.
};
mt::mill_to_millboss__global
:=
THE mill_to_millboss;
guiboss_to_millboss
=
{ do_one_frame # Guiboss calls this at 50Hz to help us service mill wakeups.
};
exports = { guiboss_to_millboss };
to = make_replyqueue();
#
put_in_oneshot (reply_oneshot, (me_slot, exports)); # Return value from millboss_egg'().
(take_from_mailslot me_slot) # Imports from millboss_egg'().
->
{ me, millboss_arg, imports, run_gun', end_gun' };
block_until_mailop_fires run_gun'; # Wait for the starting gun.
millgraph_watchers = REF mt::ipm::empty;
run ( millboss_q, # Will not return.
{ id,
me,
millboss_arg,
imports,
to,
#
millgraph_outport,
millgraph_millout => *millgraph_millout, #
millgraph_watchers,
#
end_gun'
}
);
}
where
millboss_q = make_mailqueue (get_current_microthread()): Millboss_Q;
millgraph_outport
=
{ mill_id => id,
outport_name => "millgraph"
};
millgraph_millout # First half of a grody little hack to deal with mutual recursion between millgraph__millout and note_millgraph_watcher + drop_millgraph_watcher.
= #
REF ( #
mmo::wrap__millgraph_millout # Wrap it so millboss, millgraph-mill &tc don't need to know about port-specific types.
( #
millgraph_outport, #
millgraph_millout #
) #
where
fun dummy__note_millgraph_watcher #
( #
watcher: mt::Inport, #
millin: Null_Or(mt::Millin), # This will be NULL if watcher is not another mill (e.g. a pane).
watchfn: (mt::Outport, mt::Millgraph) -> Void #
) #
= #
(); # Just has to be type correct.
fun dummy__drop_millgraph_watcher (watcher: mt::Inport) #
= #
(); # Just has to be type correct.
millgraph_millout #
= #
{ note_watcher => dummy__note_millgraph_watcher, #
drop_watcher => dummy__drop_millgraph_watcher #
}; #
end
);
fun note_textmill_statechange # Track textmill name changes.
(
outport: mt::Outport,
statechange: mt::Textmill_Statechange
)
=
case statechange
#
mt::NAME_CHANGED { was: String, now: String }
=>
put_in_mailqueue (millboss_q,
#
\\ (runstate as { me, ... }: Runstate)
=
case (idm::get (*me.mills_by_id, outport.mill_id))
#
THE mill_info
=>
{ mill_info # Remember new name of mill. This is one of those places where functional record update support in the compiler would be nice.
=
{ name => now, # The updated field.
freshness => id_to_int (issue_unique_id()), # Might as well update freshness too.
#
mill_id => mill_info.mill_id, # The unchanged fields.
app_to_mill => mill_info.app_to_mill, #
pane_to_mill => mill_info.pane_to_mill, #
filepath => mill_info.filepath, #
millins => mill_info.millins, #
millouts => mill_info.millouts, #
millboss_to_mill => mill_info.millboss_to_mill #
};
me.mills_by_name := sm::drop (*me.mills_by_name, was); # Forget old name of mill.
note_mill_info (runstate, mill_info); # Remember mill under its new name.
};
#
NULL =>
{ msg = sprintf "outport.id (%d) not in *me.mills_by_id!"
(id_to_int outport.mill_id);
log::fatal msg;
raise exception DIE msg;
};
esac
);
mt::TEXTSTATE_CHANGED _ => (); # We list the rest explicitly here so as to draw a compile error if a new one gets added without us being updated.
mt::UNDO _ => ();
mt::FILEPATH_CHANGED _ => ();
mt::READONLY_CHANGED _ => ();
mt::DIRTY_CHANGED _ => ();
esac;
#################################################################################
# mill_to_millboss interface fns::
#
#
fun find_first_unused_pane_tag #
( #
me: Millboss_State
): Int
=
{ panes = idm::vals_list *me.panes_by_id;
panes = lms::sort_list gt panes
where
fun gt ( pane1: Pane_Info,
pane2: Pane_Info
)
=
pane1.pane_tag > pane2.pane_tag;
end;
#
try (panes, 1) # All pane tags should be greater than zero.
where
fun try ((pane: Pane_Info) ! rest, n) # Search sequentially through sorted list for first unused pane tag value.
=>
if (pane.pane_tag > n) n;
else try (rest, n+1);
fi;
try ([], n) => n;
end;
end;
};
fun note_pane # Used to inform us of newly created panes, and also to update us when the mill associated with a pane changes.
{ # (Currently the only time we change the mill associated with a pane is in find_file -- fundamental-mode.pkg's switch_to_mill() just creates a new pane.)
millboss_to_pane: b2p::Millboss_To_Pane,
mill_id: Id
}
=
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ pane_id = millboss_to_pane.pane_id;
#
pane_tag = case (idm::get (*me.panes_by_id, pane_id)) # We assign each pane the smallest unused positive tag, to be displayed on modeline and used by "C-x o" (other_pane) in src/lib/x-kit/widget/edit/fundamental-mode.pkg #
THE pane_info
=>
pane_info.pane_tag; # We already knew about pane, so retain its existing pane_tag.
NULL =>
{ pane_tag = find_first_unused_pane_tag me; # This is a new pane.
millboss_to_pane.note_tag pane_tag; # Tell the pane what tag we assigned it.
pane_tag;
};
esac;
me.panes_by_id # Remember what we've learned/decided about this pane.
:=
idm::set (*me.panes_by_id, pane_id, pane_info)
where
pane_info = { pane_id,
pane_tag,
mill_id,
millboss_to_pane
};
end;
case (idm::get (*me.pending_pane_mail, pane_id)) # Deliver any pending mail for this pane.
#
THE (pending_pane_mail: List( Crypt ))
=>
{ apply do_crypt (reverse pending_pane_mail) # We reverse to restore original message ordering.
#
where
fun do_crypt (crypt: Crypt)
=
millboss_to_pane.note_crypt crypt;
end;
me.pending_pane_mail # Forget about delivered mail, so we don't deliver it again.
:=
idm::drop (*me.pending_pane_mail, pane_id);
};
NULL => ();
esac;
case (idm::get (*me.mills_by_id, mill_id)) # Freshen mill.
#
THE mill_info
=>
{ freshness = id_to_int (issue_unique_id());
#
mill_info = { freshness, # Updated field.
#
mill_id => mill_info.mill_id, # Unchanged fields. Oh, for functional record updates! :-)
app_to_mill => mill_info.app_to_mill, #
pane_to_mill => mill_info.pane_to_mill, #
name => mill_info.name, #
filepath => mill_info.filepath, #
millins => mill_info.millins, #
millouts => mill_info.millouts, #
millboss_to_mill => mill_info.millboss_to_mill #
};
note_mill_info (r, mill_info);
};
NULL => (); # Mill has not registered yet.
esac;
}
);
fun mail_pane # Send something to a pane. If the pane is not yet registered with millboss, the crypt will be queued up and delivered when the pane registers. Used for linking up screenline.pkg instances to textpane.pkg instances at startup (etc).
( # Using a Crypt here makes the mechanism general at a small cost in typesafety. In particular, it buys us valuable modularity by keeping millboss from needing to know the types of the interfaces between textpane and screenline (etc).
pane_id: Id, #
crypt: Crypt
)
=
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
case (idm::get (*me.panes_by_id, pane_id)) # Has the given pane registered with us yet?
#
THE pane_info # Yes,
=> # so
pane_info.millboss_to_pane.note_crypt crypt; # deliver the mail immediately.
NULL => # No, so queue up the mail for later delivery.
#
case (idm::get (*me.pending_pane_mail, pane_id)) # Is there already pending mail for this pane?
#
THE pending_pane_mail # Yes,
=> # so
me.pending_pane_mail # prepend
:= # new mail
idm::set ( *me.pending_pane_mail, # to
pane_id, # existing
crypt ! pending_pane_mail # queued-mail
); # list.
NULL => # No, so
me.pending_pane_mail # start a new
:= # list of
idm::set (*me.pending_pane_mail, pane_id, [ crypt ]); # pending mail for that pane.
esac;
esac
);
fun drop_pane
{
pane_id: Id
}
=
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
me.panes_by_id
:=
idm::drop (*me.panes_by_id, pane_id)
);
fun get_panes_by_id ()
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( idm::Map(mt::Pane_Info) );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ result = idm::map do_pane *me.panes_by_id
where
fun do_pane ({ pane_id, pane_tag, mill_id, ... }: Pane_Info)
=
{ pane_id, pane_tag, mill_id };
end;
put_in_oneshot (reply_oneshot, result);
}
);
get_from_oneshot reply_oneshot;
};
fun get_mills_by_name ()
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( sm::Map(mt::Mill_Info) );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ result = *me.mills_by_name;
#
put_in_oneshot (reply_oneshot, result);
}
);
get_from_oneshot reply_oneshot;
};
fun get_mills_by_id ()
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( idm::Map(mt::Mill_Info) );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ result = *me.mills_by_id;
#
put_in_oneshot (reply_oneshot, result);
}
);
get_from_oneshot reply_oneshot;
};
fun note_millwatch (millwatch: mt::Millwatch) # Remember new instance of inport on one mill watching outport on another mill.
=
{ put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ key = { inport => millwatch.millin.inport,
outport => millwatch.millout.outport
};
me.millwatches
:=
mt::mwm::set (*me.millwatches, key, millwatch);
maybe_update_millgraph_watchers r;
}
);
};
fun drop_millwatch (key: mt::millwatch_key::Key) # Opposite of above: Forget that input port was watching output port.
=
{ put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ me.millwatches
:=
mt::mwm::drop (*me.millwatches, key);
maybe_update_millgraph_watchers r;
}
);
};
fun wake_me # Used to schedule millboss_to_mill.wakeup calls.
{
id: Id,
options: List(mt::Wake_Me_Option)
}
=
{ put_in_mailqueue (millboss_q,
#
\\ (r as { me, ... }: Runstate)
=
{ i = case (idm::get (*me.mill_wakeups, id))
#
THE per_mill_wakeup_info => per_mill_wakeup_info;
#
NULL => { at_frame_n => REF NULL,
every_n_frames => REF NULL
};
esac;
apply do_option options
where
fun do_option (option: gt::Wake_Me_Option)
=
case option
#
gt::AT_FRAME_N NULL => i.at_frame_n := NULL;
gt::EVERY_N_FRAMES NULL => i.every_n_frames := NULL;
#
gt::AT_FRAME_N (THE (at_frame, wakeup_fn)) => i.at_frame_n := THE { at_frame, wakeup_fn };
gt::EVERY_N_FRAMES (THE (n, wakeup_fn)) => i.every_n_frames := THE { n, wakeup_fn, next => REF ( *me.current_frame_number + n) };
esac;
end;
case (*i.at_frame_n, *i.every_n_frames)
#
(NULL, NULL ) => me.mill_wakeups := idm::drop (*me.mill_wakeups, id );
_ => me.mill_wakeups := idm::set (*me.mill_wakeups, id, i);
esac;
}
);
};
stipulate
cutbuffer_contents = REF (ct::PARTLINE "");
herein
fun get_cutbuffer_contents ()
=
*cutbuffer_contents; # We do this in caller's thread (not millboss thread) for speed and to reduce risk of deadlock.
fun set_cutbuffer_contents (new_contents: ct::Cutbuffer_Contents)
=
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
cutbuffer_contents := new_contents # We do this in the millboss thread to ensure cutbuffer_contents value remains stable over any millboss_imp call, just as good practice.
);
end;
fun uniquify_name # Convert "foo" into "foo<1>" or "foo<2>" or such in order to avoid conflicting with any existing name.
(
me: Millboss_State,
name: String
)
: String
=
case (sm::get (*me.mills_by_name, name))
#
NULL => name; # Name is already unique.
THE _ =>
uniquify_name' 0
where
fun uniquify_name' (i: Int)
=
{ name' = sprintf "%s<%d>" name i;
#
case (sm::get (*me.mills_by_name, name'))
#
NULL => name'; # Modified name is now unique.
THE _ => uniquify_name' (i + 1); # Modified name already exists, try one number higher.
esac;
};
end;
esac;
fun get_textmill (name: String)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Null_Or( mt::Textpane_To_Textmill ) );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
case (tmt::get__null_or_textpane_to_textmill__from__null_or_textmill_info
(sm::get (*me.mills_by_name, name))
)
#
THE textpane_to_textmill => put_in_oneshot (reply_oneshot, THE textpane_to_textmill);
NULL => put_in_oneshot (reply_oneshot, NULL);
esac
);
get_from_oneshot reply_oneshot;
};
fun make_textmill # Create a buffer, If an existing buffer has given name, modify the new buffer's name to make it unique.
(
textmill_arg
as
{ name: String,
textmill_options: List( mt::Textmill_Option )
}: mt::Textmill_Arg
)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( mt::Textpane_To_Textmill );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ name = uniquify_name (me, name); # Convert "foo" into "foo<1>" or "foo<2>" or such in order to avoid conflicting with any existing name.
#
egg = tbi::make_textmill_egg textmill_arg;
#
(egg ())
->
( textmill_exports: tbi::Exports,
egg': (tbi::Imports, Run_Gun, End_Gun) -> Void
);
textmill_imports
=
{ };
(make_run_gun ()) -> { run_gun', fire_run_gun };
(make_end_gun ()) -> { end_gun', fire_end_gun };
egg' (textmill_imports, run_gun', end_gun');
fire_run_gun ();
textmill_exports
->
{ textpane_to_textmill as mt::TEXTPANE_TO_TEXTMILL tb,
millboss_to_mill
};
tb.app_to_mill -> mt::APP_TO_MILL am;
millins = am.millins ;
millouts = am.millouts;
mill_info = { name,
freshness => id_to_int (issue_unique_id()),
mill_id => tb.id,
filepath => NULL,
app_to_mill => tb.app_to_mill,
pane_to_mill => tmt::encrypt__textpane_to_textmill textpane_to_textmill,
millins,
millouts,
millboss_to_mill
};
note_mill_info (r, mill_info);
watcher = { mill_id => id, inport_name => "" }: mt::Inport;
tb.note__textmill_statechange__watcher (watcher, NULL, note_textmill_statechange); # We subscribe just to track textmill name changes.
put_in_oneshot (reply_oneshot, textpane_to_textmill);
}
);
get_from_oneshot reply_oneshot;
};
fun get_or_make_textmill # Find a buffer by name; if no such buffer exists, create one. Buffer may or may not have an associated file.
(
textmill_arg
as
{ name: String,
textmill_options: List( mt::Textmill_Option )
}: mt::Textmill_Arg
)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( mt::Textpane_To_Textmill );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
case (tmt::get__null_or_textpane_to_textmill__from__null_or_textmill_info
(sm::get (*me.mills_by_name, name))
)
#
THE textpane_to_textmill
=>
put_in_oneshot (reply_oneshot, textpane_to_textmill);
#
NULL =>
{ egg = tbi::make_textmill_egg textmill_arg;
#
(egg ())
->
( textmill_exports: tbi::Exports,
egg': (tbi::Imports, Run_Gun, End_Gun) -> Void
);
textmill_imports
=
{ };
(make_run_gun ()) -> { run_gun', fire_run_gun };
(make_end_gun ()) -> { end_gun', fire_end_gun };
egg' (textmill_imports, run_gun', end_gun');
fire_run_gun ();
textmill_exports
->
{ textpane_to_textmill as mt::TEXTPANE_TO_TEXTMILL tb,
millboss_to_mill
};
tb.app_to_mill -> mt::APP_TO_MILL am;
millins = am.millins ;
millouts = am.millouts;
mill_info = { name,
freshness => id_to_int (issue_unique_id()),
mill_id => tb.id,
filepath => NULL,
app_to_mill => tb.app_to_mill,
pane_to_mill => tmt::encrypt__textpane_to_textmill textpane_to_textmill,
millins,
millouts,
millboss_to_mill
};
note_mill_info (r, mill_info);
watcher = { mill_id => id, inport_name => "" }: mt::Inport;
tb.note__textmill_statechange__watcher # We subscribe just to track textmill name changes.
(
watcher,
NULL,
note_textmill_statechange
);
put_in_oneshot (reply_oneshot, textpane_to_textmill);
};
esac
);
get_from_oneshot reply_oneshot;
};
fun get_or_make_filebuffer # Find buffer open on given file. If no such buffer exists, create one. NB: We do our best to avoid having more than one buffer open on a given file. (Multiple textpanes may be open on one buffer; that is a separate issue.)
(
textmill_arg
as
{ name: String,
textmill_options: List( mt::Textmill_Option )
}: mt::Textmill_Arg
)
(
filepath: String
)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( mt::Textpane_To_Textmill );
#
put_in_mailqueue (millboss_q,
#
\\ (r as { id, me, ... }: Runstate)
=
{ name = if (name == "") sj::basename filepath;
else name;
fi;
name = uniquify_name (me, name);
#
textmill_arg = { name, textmill_options };
egg = tbi::make_textmill_egg textmill_arg;
#
(egg ())
->
( textmill_exports: tbi::Exports,
egg': (tbi::Imports, Run_Gun, End_Gun) -> Void
);
textmill_imports
=
{ };
(make_run_gun ()) -> { run_gun', fire_run_gun };
(make_end_gun ()) -> { end_gun', fire_end_gun };
egg' (textmill_imports, run_gun', end_gun');
fire_run_gun ();
textmill_exports -> { textpane_to_textmill as mt::TEXTPANE_TO_TEXTMILL tb,
millboss_to_mill
};
tb.app_to_mill -> mt::APP_TO_MILL am;
millins = am.millins ;
millouts = am.millouts;
mill_info = { name,
freshness => id_to_int (issue_unique_id()),
mill_id => tb.id,
filepath => THE filepath,
app_to_mill => tb.app_to_mill,
pane_to_mill => tmt::encrypt__textpane_to_textmill textpane_to_textmill,
millins,
millouts,
millboss_to_mill
};
note_mill_info (r, mill_info);
watcher = { mill_id => id, inport_name => "" }: mt::Inport;
tb.note__textmill_statechange__watcher # We subscribe just to track textmill name changes.
(
watcher,
NULL,
note_textmill_statechange
);
am.set_filepath (THE filepath);
am.reload_from_file ();
put_in_oneshot (reply_oneshot, textpane_to_textmill);
}
);
get_from_oneshot reply_oneshot;
};
#################################################################################
# Guiboss_To_Millboss interface fns::
#
#
fun do_one_frame (frame_number: Int) # Called by guiboss at 50Hz, helps us service mill wakeups.
=
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
{ wakeups = idm::keyvals_list *me.mill_wakeups;
#
apply do_wakeup wakeups
where
fun find_mill_info (id: Id)
=
case (idm::get (*me.mills_by_id, id))
#
THE mill_info => mill_info;
NULL => { msg = sprintf "wakeup mill %d not found in mills_by_id --millboss_imp::do_one_frame" (id_to_int id);
log::fatal msg;
raise exception DIE msg;
};
esac;
fun do_wakeup
(
id: Id,
wu: Per_Mill_Wakeup_Info
)
=
{ wu -> { at_frame_n: Ref ( Null_Or # Call mill.wakeup once, during frame N, and pass wakeup_fn in call. NULL means this wakeup is off.
{ at_frame: Int,
wakeup_fn: mt::Wakeup_Arg -> Void
}
),
every_n_frames: Ref ( Null_Or # Call gadget.wakeup every N frames, and pass wakeup_fn in call. NULL means this wakeup is off.
{ n: Int,
next: Ref(Int),
wakeup_fn: mt::Wakeup_Arg -> Void
}
)
};
case *at_frame_n
#
THE { at_frame: Int,
wakeup_fn: mt::Wakeup_Arg -> Void
}
=>
if (frame_number == at_frame)
#
mill_info = find_mill_info id;
mill_info.millboss_to_mill.wakeup { wakeup_arg => { frame_number }, wakeup_fn };
elif (frame_number > at_frame)
#
case *every_n_frames
#
THE _ => at_frame_n := NULL; # We've done the call, null out the request for it.
NULL => me.mills_by_id := idm::drop (*me.mills_by_id, id); # No longer any wakeup work scheduled for this mill, so just drop its record.
esac;
fi;
NULL => ();
esac;
case *every_n_frames
#
THE { n: Int,
next: Ref(Int),
wakeup_fn: mt::Wakeup_Arg -> Void
}
=>
if (frame_number >= *next)
#
mill_info = find_mill_info id;
#
mill_info.millboss_to_mill.wakeup { wakeup_arg => { frame_number }, wakeup_fn };
next := frame_number + n;
fi;
NULL => ();
esac;
};
end;
}
);
#################################################################################
# App_To_Mill interface fns::
#
#
fun get_pane_guiplan (): gt::Gp_Widget_Type # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( gt::Gp_Widget_Type );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
{
# filepath = *me.filepath;
# textpane_hint = *me.textpane_hint;
# #
# gp_widget = *make_pane_guiplan__hack { textpane_to_textmill, filepath, textpane_hint };
# XXX BUGGO FIXME TBD
gp_widget = gt::NULL_WIDGET;
put_in_oneshot (reply_oneshot, gp_widget);
}
);
get_from_oneshot reply_oneshot;
};
#
fun pass_pane_guiplan (replyqueue: Replyqueue) (reply_handler: gt::Gp_Widget_Type -> Void): Void # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( gt::Gp_Widget_Type );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
{
# filepath = *me.filepath;
# textpane_hint = *me.textpane_hint;
# #
# gp_widget = *make_pane_guiplan__hack { textpane_to_textmill, filepath, textpane_hint };
# XXX BUGGO FIXME TBD
gp_widget = gt::NULL_WIDGET;
put_in_oneshot (reply_oneshot, gp_widget);
}
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
#
fun get_dirty () # PUBLIC. We don't actually support a 'dirty' flag on millboss, so this is always FALSE.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Bool );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, FALSE)
);
get_from_oneshot reply_oneshot;
};
#
fun pass_dirty (replyqueue: Replyqueue) (reply_handler: Bool -> Void) # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Bool );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, FALSE)
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun set_filepath (filepath: Null_Or( String )) # PUBLIC. We don't support a filepath on millboss, so this is a no-op.
=
{ put_in_mailqueue (millboss_q,
#
\\ (runstate as { id, me, millgraph_watchers, ... }: Runstate)
=
{
}
);
};
#
fun get_filepath () # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Null_Or( String ) );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, millgraph_watchers, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, NULL) # We don't support a filepath on millboss, so this is always NULL.
);
get_from_oneshot reply_oneshot;
};
#
fun pass_filepath (replyqueue: Replyqueue) (reply_handler: Null_Or( String ) -> Void) # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Null_Or( String ) );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, NULL) # We don't support a filepath on millboss, so this is always NULL.
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun set_name (name: String) # PUBLIC.
=
{ put_in_mailqueue (millboss_q,
#
\\ (runstate as { id, me, millgraph_watchers, ... }: Runstate)
=
{
me.name := name;
}
);
};
#
fun get_name () # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( String );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, *me.name)
);
get_from_oneshot reply_oneshot;
};
#
fun pass_name (replyqueue: Replyqueue) (reply_handler: String -> Void) # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( String );
#
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, *me.name)
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun note_millgraph_watcher # PUBLIC.
( #
watcher: mt::Inport, #
millin: Null_Or(mt::Millin), # This will be NULL if watcher is not another mill (e.g. a pane).
watchfn: (mt::Outport, mt::Millgraph) -> Void #
)
=
{ put_in_mailqueue (millboss_q,
#
\\ (runstate as { id, me, millgraph_watchers, ... }: Runstate)
=
{ millgraph_watchers
:=
mt::ipm::set ( *millgraph_watchers,
watcher,
(watcher, watchfn)
);
tell_millgraph_watcher_current_state (watchfn, runstate); # Start out new watcher with current state.
}
);
};
#
fun drop_millgraph_watcher (watcher: mt::Inport) # PUBLIC.
=
{
put_in_mailqueue (millboss_q,
#
\\ ({ id, me, millgraph_watchers, ... }: Runstate)
=
millgraph_watchers
:=
mt::ipm::drop (*millgraph_watchers, watcher)
);
};
millgraph_millout # Second half of grody little hack to deal with mutual recursion between millgraph__millout and note_millgraph_watcher + drop_millgraph_watcher.
:= #
mmo::wrap__millgraph_millout # Wrap it so millboss, millgraph-mill &tc don't need to know about port-specific types.
( #
millgraph_outport, #
# #
{ note_watcher => note_millgraph_watcher, #
drop_watcher => drop_millgraph_watcher #
} #
); #
fun make_millouts # Construct a description of all our outports, for client use.
( #
millgraph_outport: mt::Outport, #
millgraph_millout: mt::Millout #
) #
: mt::opm::Map(mt::Millout) #
= #
{ millouts = mt::opm::empty; # Start with an empty outport map.
# #
millouts = mt::opm::set (millouts, millgraph_outport, millgraph_millout); # Add our millgraph outport.
millouts; # Return map defining all our our outports.
};
fun reload_from_file () # PUBLIC. We don't support a filepath or state save/restore so this is a no-op.
=
{ put_in_mailqueue (millboss_q,
#
\\ ({ id, me, ... }: Runstate)
=
()
);
};
#
fun save_to_file () # PUBLIC. We don't support a filepath or state save/restore so this is a no-op.
=
{ put_in_mailqueue (millboss_q,
#
\\ (runstate as { id, me, millgraph_watchers, ... }: Runstate)
=
()
);
};
end;
#
fun process_options (options: List(Millboss_Option), { name, id })
=
{ my_name = REF name;
my_id = REF id;
#
apply do_option options
where
fun do_option (MICROTHREAD_NAME n) => my_name := n;
do_option (ID i) => my_id := i;
end;
end;
{ name => *my_name,
id => *my_id
};
};
##########################################################################################
# PUBLIC.
#
fun make_millboss_egg # PUBLIC. PHASE 1: Construct our state and initialize from 'options'.
(millboss_arg: Millboss_Arg) # Called (only) by startup() in src/lib/x-kit/widget/gui/guiboss-imp.pkg =
{ millboss_arg -> (millboss_options); # Currently no guiboss_needs component, so this is a no-op.
#
(process_options
( millboss_options,
{ name => "millboss",
id => id_zero
}
) )
->
{ name,
id
};
my (id, millboss_options)
=
if (id_to_int(id) == 0)
id = issue_unique_id(); # Allocate unique imp id.
(id, ID id ! millboss_options); # Make our id stable across stop/restart cycles.
else
(id, millboss_options);
fi;
millboss_arg = (millboss_options); # Currently no guiboss_needs component, so this is a no-op.
me = { mills_by_name => REF sm::empty, # All currently active mills, by name.
mills_by_id => REF idm::empty, # All currently active mills, by id.
mills_by_filepath => REF sm::empty, # All currently active mills WHICH ARE OPEN ON A FILE, by filename.
#
millwatches => REF mt::mwm::empty, # Everything we know about mill inports watching mill outports.
#
mill_wakeups => REF idm::empty, # Mills which want wakeme calls.
current_frame_number => REF 0,
#
pending_pane_mail => REF idm::empty, # Messages to panes which have not yet registered with us, indexed by pane_id. To preserve message order we reverse these lists before delivering them (although message order should rarely if ever matter).
panes_by_id => REF idm::empty, # All currently active panes, by id.
#
name => REF "millboss" # Name of millboss-imp for display purposes.
};
\\ () = { reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( (Me_Slot, Exports) ); # PUBLIC. PHASE 2: Start our microthread and return our Exports to caller.
#
xlogger::make_thread name (startup (id, reply_oneshot)); # Note that startup() is curried.
(get_from_oneshot reply_oneshot) -> (me_slot, exports);
fun phase3 # PUBLIC. PHASE 3: Accept our Imports, then wait for Run_Gun to fire.
(
imports: Imports,
run_gun': Run_Gun,
end_gun': End_Gun
)
=
{
put_in_mailslot (me_slot, { me, millboss_arg, imports, run_gun', end_gun' });
};
(exports, phase3);
};
};
};
end;