## generate-gui-g.pkg
## Author: cxl
## (C) 1996, 1998, Bremen Institute for Safe Systems, Universitaet Bremen
## **************************************************************************
# Compiled by:
# src/lib/tk/src/toolkit/sources.sublib# ***************************************************************************
# A generic graphical user interface.
#
# See <a href=file:../../doc/manual.html>the documentation</a> for more
# details.
#
# "tests+examples/simpleinst.pkg" contains a small example of how to
# use this package.
# **************************************************************************
### "I honestly think it is better
### to be a failure at something you love
### than to be a success at something you hate."
###
### -- George Burns
generic package generate_gui_g (package appl: Application;) # Application is from src/lib/tk/src/toolkit/appl.api: (weak) Generated_Gui # Generated_Gui is from src/lib/tk/src/toolkit/generated-gui.api{
include package tk;
include package basic_utilities;
default_printmode= { mode => print::long,
printdepth=>100,
height=>NULL,
width=>NULL }; # the value is temporary
fun debugmsg msg = debug::print 11 ("GenGUI: " + msg);
# the construction area frame widget id
ca_frame_id = make_tagged_widget_id("ca");
# the widget id of the canvas all the items are placed on
# flag indicating wether the construction area is currently open
ca_open = REF (NULL: Null_Or( appl::Part_Ilk ));
fun open_con_area {
window,
obj,
replace_object_action,
outline_object_action
}
=
{
# id of the window holding the con/area widgets
cawin = appl::conf::one_window
?? window
:: make_window_id ();
# event_callbacks for the con area while open:
fun ca_enter wsp ev
=
{ dropobs = appl::cb_objects_rep (appl::clipboard::copy ev)();
oot = appl::objlist_type dropobs;
case oot
THE ot => appl::area_ops ot wsp dropobs;
NULL => ();
esac;
}
except
appl::clipboard::EMPTY = ();
fun ca_namings wsp
=
[EVENT_CALLBACK (ENTER, ca_enter wsp)];
# event_callbacks for the con/area while closed:
ca_closed_namings
=
[EVENT_CALLBACK (ENTER, k0)];
fun close_con_area nu_ob
=
{ ca_open := NULL;
replace_object_action nu_ob;
if appl::conf::one_window
apply (delete_widget o get_widget_id)
(get_subwidgets (get_widget ca_frame_id));
else
close_window cawin;
fi;
};
if ( (appl::is_constructed (appl::part_type obj))
and not (null_or::not_null *ca_open)
)
# Get the con/area widgets from the application:
#
my (wsp, wwidgs, init) = appl::area_open (cawin, obj,
close_con_area);
# Add con/area event_callbacks to widgets:
#
wwidgs = map (\\ w=> update_widget_event_callbacks w
((ca_namings wsp)@
(get_widget_event_callbacks w)); end )
wwidgs;
outline_object_action ();
ca_open := THE obj; # Set flag.
if appl::conf::one_window
apply (add_widget window ca_frame_id) wwidgs;
add_event_callbacks ca_frame_id (ca_namings wsp);
init();
else
open_window (
make_window {
window_id => cawin,
subwidgets => PACKED wwidgs,
event_callbacks => [],
init,
traits => [ WINDOW_TITLE (appl::conf::ca_title
(appl::string_of_name
(appl::name_of obj)
(default_printmode))),
WIDE_HIGH_X_Y (THE (appl::conf::ca_width,
appl::conf::ca_height),
appl::conf::ca_xy),
WINDOW_GROUP window
]
}
);
fi;
else
debugmsg "Not a primary object, or ConArea already open.";
fi;
};
# And a function to check that
fun is_open ob
=
case *ca_open
NULL => FALSE;
THE ob2 => case (appl::ord (ob, ob2))
EQUAL => TRUE;
_ => FALSE;
esac;
esac;
package notepadappl
=
package {
include package appl;
object_action = open_con_area;
fun activate_action { pos=>(x, y) } = ();
is_locked_object = is_open;
};
package notepad = notepad_g (package appl = notepadappl;);
include package notepad;
fun main_wid window
=
{ ass_area = notepad::main_wid window;
if appl::conf::one_window
FRAME {
widget_id => make_widget_id(),
packing_hints => [],
event_callbacks => [],
traits => [],
subwidgets => PACKED [
ass_area,
FRAME {
widget_id => ca_frame_id,
subwidgets => PACKED [],
packing_hints => [FILL ONLY_X, PACK_AT BOTTOM],
event_callbacks => [],
traits => [ HEIGHT appl::conf::ca_height,
WIDTH appl::conf::ca_width
]
}
]
};
else
ass_area;
fi;
};
fun init state
=
{ notepad::init state;
ca_open := NULL;
appl::area_init ();
};
Cb_Objects = appl::Cb_Objects;
cb_objects_rep = appl::cb_objects_rep;
cb_objects_abs = appl::cb_objects_abs;
};