## clipboard-g.pkg
## Author: cxl
## (C) 1996, Bremen Institute for Safe Systems, Universitaet Bremen
# Compiled by:
# src/lib/tk/src/toolkit/sources.sublib# ***************************************************************************
# The clipboard is used to exchange objects between different drag&drop
# canvases or other manipulation areas.
# **************************************************************************
# In the following Tk_Events are used to certify events, to make sure
# that only matching pairs of objects are put/got. That ensures that
# an object can only be got from the clibboard if it it has been put
# there with the same mouse event-- in other words, you don't drop
# your object somewhere, take the mouse around the screen for an
# extended tour, and finally two hours later end up in another window
# with still something in the clipboard. The second argument to put
# is a "callback" function which is executed once the object has been
# successfully taken out of the clipboard with the get function; an
# example here would be to delete the object in the old window once
# it has appeared elswhere. The "copy" function does the same as get,
# except it _doesn't_ call the callback function, allowing eg. the copying
# of the object in the clipboard. Of course, the object disappears from
# the clipboard.
#
# You can imagine a more generic version of this parameterized with
# type stamp eq: stamp -> stamp -> Bool but then what would be the use
# of that and it would make debugging mair complicated an' aw.
#
# There are two additional sub-apis of Clipboard given, which you can
# use to coerce to clipboard to being read-only or write-only (i.e. you
# can only get things or put things)
api Clipboard {
Part;
exception EMPTY;
get: tk::Tk_Event -> Part;
copy: tk::Tk_Event -> Part;
put: Part -> tk::Tk_Event -> (Void -> Void) -> Void;
is_empty: tk::Tk_Event -> Bool;
/* axiom is_empty e <==> exists o. o= get e
axiom get e ==> is_empty f
-- i.e. even an unsuccessful get will empty the clipboard
*/
};
api Read_Only_Clipboard { # read-only access to the clipboard
Part;
exception EMPTY;
get: tk::Tk_Event -> Part;
copy: tk::Tk_Event -> Part;
is_empty: tk::Tk_Event -> Bool;
};
api Write_Only_Clipboard { # write-only access to the clipboard
Part;
put: Part -> tk::Tk_Event -> (Void -> Void) -> Void;
};
generic package clipboard_g (obj: api { Part ;}) : (weak)
Clipboard # Clipboard is from src/lib/tk/src/toolkit/clipboard-g.pkg # where type Part= obj::Part
=
package {
include package tk;
Part = obj::Part;
exception EMPTY;
cb = REF NULL: Ref( Null_Or( (Part, Tk_Event, (Void -> Void)) ) );
fun eq (TK_EVENT(_, _, _, _, x1, y1)) (TK_EVENT(_, _, _, _, x2, y2))
=
(x1 == x2) and (y1 == y2);
fun makestr e
=
"(" $ (int::to_string (tk::get_root_x_coordinate e)) $ ", " $
(int::to_string (tk::get_root_y_coordinate e)) $ ")";
fun is_empty queryst
=
case *cb
THE (_, putst, _) => not (eq putst queryst);
NULL => TRUE;
esac;
fun getit callback queryst
=
{ debug::print 10 ("Clipboard::getit " $ (makestr queryst));
case *cb
NULL => { debug::print 10 "Clipboard::getit unsuccessful (mt)"; raise exception EMPTY;};
THE (fate, putstamp, callb)
=> if (eq putstamp queryst )
cb := NULL;
if callback callb(); fi;
debug::print 10 "Clipboard::getit succesful after callback";
fate;
else
cb := NULL;
debug::print 10 "Clipboard::getit unsuccessful (no match)";
raise exception EMPTY;
fi;
esac;
};
get = getit TRUE;
copy = getit FALSE;
fun put obj stamp callb
=
{ cb:= THE (obj, stamp, callb);
debug::print 10 ("Object put with stamp " $
(makestr stamp))
;};
};
# A dummy clipboard.
#
# Use this to instantiate a clipboard-class in a package macro when
# you don't really want to use a clipboard
package dummy_cb = clipboard_g (package { Part= Void; });