events.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- events.sa: Event classes
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- events.sa,v 1.1 1995/11/15 03:36:41 gomes Exp
-- Copyright (C) 1995, International Computer Science Institute
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
-- Please see the file "Documenation"
-- Classes
-- $TK_EVENT - generic event
-- TK_EVENT_INCL - Code and modifiers common to all events
-- TK_EVENT - Standard mouse and window events
-- TK_BUTTON_EVENT - Mouse button related events
-- TK_KEY_EVENT - Key related events
----------------------- EVENTS and EVENT MODIFIERS --------------
abstract class $TK_EVENT
abstract class $TK_EVENT is
-- Events consist of
-- Event + modifiers + detail
-- Events fall into three categories
-- standard events (EVENT)
-- mouse button events (BUTTON_EVENT)
-- keyboard events (KEY_EVENT)
-- All types of events share the same set of modifiers in common
-- but different types of detail and actual events
-- Modifiers are essentially preconditions that must be satisfied
-- along with the event.
-- Only the event need be specified; the rest is optional
--
-- Examples:
-- BUTTON_EVENT::Press.double+1 = Double click on mouse button 1
-- BUTTON_EVENT::Press+1 = Single click on mouse button 1
-- KEY_EVENT::Press.Meta.Control+'d'
-- = meta and control and the letter 'd'
-- EVENT::Motion.Mouse_1 = Mouse motion while button 1 is pressed
-- EVENT::Widget_enter = Mouse entering a widget
--
-- There are shortcuts for the common mouse events
-- BUTTON_EVENT::B1 =
-- BUTTON_EVENT::Press+1 = Click on mouse button 1
-- BUTTON_EVENT::B2 =
-- BUTTON_EVENT::Press+2 = Click on mouse button 2
--
str: STR;
-- String that specifies the event to tk
cb_str: STR;
-- String used to specify information for the callback
-- Not yet specified for all events
end;
immutable class TK_EVENT_INFO
immutable class TK_EVENT_INFO is
-- Information about an event. Created from the argument string.
-- This should really be part of an even hierarchy.
-- Implementation detail: Remember that the window id gets added onto
-- the beginning of the callback string. Offset all args by 1
--
-- Please see
-- http://www.icsi.berkeley.edu/~sather/Documentation/Gui/TclTkDocs/TkCmd/bind.n.html
--
-- 0 = window id
-- # = 1
-- a b c d = 2 3 4 5
-- f h k m = 6 7 8 9
-- o p s t = 10 11 12 13
-- w = 14
-- x y A B = 15 16 17 18
-- E K N R = 18 19 20 21
-- T W X Y = 22 23 24 25
shared debug: BOOL := true;
private attr args: ARRAY{STR};
create(args: ARRAY{STR}): SAME is
-- Create from the array of arguments that comes back from tcl
-- #ERR+"Num args:"+args.size+" Args:"+args.str+"\n";
res: SAME;
return res.args(args);
end;
str: STR is
-- Return the args as a single string
res ::= "Num args:"+args.size+" args:"+args.str+"\n";
res := "Is valid key:"+has_key+"\n";
if has_key then
res := res+"Key:"+key+"\n";
end;
res := res+"Is valid button:"+has_button_number+"\n";
if has_button_number then
res := res+"Button number:"+button_number+"\n";
end;
if has_coordinates then
x,y:INT;
mouse_coordinates(out x,out y);
res := res+"Mouse coordinates:"+x+","+y+"\n";
end;
return res;
end;
has_button_number: BOOL is return valid(args[3]) end;
button_number: INT pre has_button_number is
-- #ERR+"Button string:"+args[3];
return args[3].cursor.int;
end;
has_coordinates: BOOL is return valid(args[15]) and valid(args[16]); end;
mouse_coordinates(out x,out y: INT) is
x := args[15].cursor.int;
y := args[16].cursor.int;
end;
has_key:BOOL is return valid_ascii(args[17]); end;
key:CHAR pre has_key is
return args[17][1];
end;
private valid(s: STR): BOOL is
-- Return true if the field is valid, i.e. the first character
-- is not the @ sign. Use valid_ascii for that field
return (s[0] /= '@');
end;
private valid_ascii(s: STR): BOOL is
-- Return true if the field is valid, i.e. the first character
-- is not the @ sign. The second character then holds the actual char
-- Specially for the %A field. May be needed for other fields that
-- can return an @ sign as a valid value
return (s[0] = '&')
end;
private deb(msg: STR): BOOL is
-- If checking is on, and the debug flag is set, the message will be
-- printed
if debug then #ERR+msg+"\n"; end;
return true;
end;
end;
immutable class TK_EVENT_INCL
immutable class TK_EVENT_INCL is
-- Used by inclusion in all events.
-- All modifiers are specified here
private attr internal_str: STR;
private attr detail: STR;
private attr has_detail: BOOL; -- By default detail is not specified
private const default_cb: STR := "@# @a @b @c @d @f @h @k @m @o @p @s @t @w @x @y @@A @B @E @K @N @R @T @W @X @Y";
-- No callback info until a string is actualy set, no information is provided
str: STR is
-- Return the string that Tcl needs to describe this event
if void(detail) or detail.size = 0 then
return "<"+internal_str+">";
else return "<"+internal_str+"-"+detail+">"; end;
end;
private create(s: STR): SAME is
-- Should not be created directly, but by one of the other
-- calls.
res:SAME;
return res.internal_str(s);
end;
private set_detail(s: STR): SAME is
-- Set the detail field of this event.
verify_non_void(s);
if has_detail then raise "Detail already specified!\n"; end;
return detail(s).has_detail(true)
end;
private prepend(c: STR): SAME is
-- Prepend some new modifier
verify_non_void(c);
return internal_str(c+"-"+internal_str);
end;
-- Modification routines. Self must already be created
Control:SAME is return prepend("Control") end;
-- Event Modifier: hold down the control key as well to trigger the
-- event
Meta:SAME is return prepend("Meta") end;
-- Event Modifier: hold down the meta key as well to trigger the
-- event
Shift:SAME is return prepend("Shift") end;
-- Event Modifier: hold down the shift key as well to trigger the
-- event
Alt:SAME is return prepend("Alt") end;
-- Event Modifier: hold down the alt key as well to trigger the
-- event
Caps_lock:SAME is return prepend("Lock") end; -- lock,any are pSather
-- Event Modifier: hold down the caps lock key as well to trigger the
-- event
Ignore_others:SAME is return prepend("Any") end; -- keywords
Double:SAME is return prepend("Double") end;
-- Double occurrence of the same event, usually a click
Triple:SAME is return prepend("Triple") end;
-- Note: Events that the following modifiers refer to HOLDING the mouse
-- down during the event and are rarely useful
Mouse_1:SAME is return prepend("Button1") end;
-- Modifier: while mouse button 1 is being held down
Mouse_2:SAME is return prepend("Button2") end;
Mouse_3:SAME is return prepend("Button3") end;
private verify_non_void(c: STR) is
-- Make sure that an event is set
if void(internal_str) then
raise "Must specify an event before adding a modifier:"+c;
end;
end;
end;
immutable class TK_EVENT < $TK_EVENT
immutable class TK_EVENT < $TK_EVENT is
-- Standard mouse and window events
-- Eg: TK_EVENT::Widget_enter
-- TK_EVENT::Widget_enter.Control
-- (enter a widget when the control button is pressed)
-- TK_EVENT::Visibility.Mouse_1(when a widget becomes visible and
-- mouse button 1 is pressed)
include TK_EVENT_INCL;
private attr cb_stored: STR;
-- String used to get the callback info from the widget
cb_str: STR is
-- Return the callback specification string. Use the default string
-- until strings have been provided for all event types
if void(cb_stored) then return default_cb else return cb_stored end;
end;
private cb(s: STR): SAME is
-- Set the callback string for this event (void otherwise)
return cb_stored(s);
end;
-- Creation routines
Widget_enter: SAME is return #("Enter") end; -- Not enter key!
Motion: SAME is return #("Motion") end;
Leave: SAME is return #("Leave") end;
Visibility: SAME is return #("Visibility") end;
Destroy: SAME is return #("Destroy") end;
Expose: SAME is return #("Expose") end;
end;
immutable class TK_BUTTON_EVENT < $TK_EVENT
immutable class TK_BUTTON_EVENT < $TK_EVENT is
-- Mouse button related events
-- Egs:
-- The common mouse button events can be specified by
-- TK_BUTTON_EVENT::B1 Click with mouse button 1
-- TK_BUTTON_EVENT::B1.Double Double click with mouse button 1
-- In general:
-- TK_BUTTON_EVENT::Press+1 Press mouse button 1
-- TK_BUTTON_EVENT::Release+2 Release mouse button 2
-- TK_BUTTON_EVENT::Press.Double+1 Double press (click) button 1
include TK_EVENT_INCL;
const cb_str: STR := "%# @a %b @c @d @f @h @k @m @o @p %s @t @w %x %y @@A @B @E @K @N @R @T @W %X %Y";
-- Same callback string for all button events
-- Creation routines
Press: SAME is return #("ButtonPress") end;
-- Event Creation: Mouse Button press event
Release: SAME is return #("ButtonRelease") end;
-- Event Creation: Mouse Button release event
B1: SAME is return #SAME("1").has_detail(true) end;
-- Event Creation: Mouse Button 1 press
B2: SAME is return #SAME("2").has_detail(true) end;
B3: SAME is return #SAME("3").has_detail(true) end;
-- Modification routines
plus(i: INT): SAME pre i >0 and i <= 5 is
-- Add on a detail field onto the event, indicating which button
-- (i). An error if you do this twice or call it after calling
-- one of B1, B2 or B3
return set_detail(i.str);
end;
end;
immutable class TK_KEY_EVENT < $TK_EVENT
immutable class TK_KEY_EVENT < $TK_EVENT is
-- Keyboard key related events. Can be used to indicate pressing a
-- particular key.
-- Eg:
-- TK_KEY_EVENT::Press.Return Hit the return key
-- TK_KEY_EVENT::Release.Tab Release the tab key
-- TK_KEY_EVENT::Press+'c' Hit the character "c"
include TK_EVENT_INCL;
private attr cb_stored: STR;
-- String used to get the callback info from the widget
const cb_str: STR := "%# @a @b @c @d @f @h %k @m @o @p %s @t @w %x %y &%A @B @E %K @N @R %T %W %X %Y";
-- Creation routines
Press: SAME is return #("KeyPress") end;
Release: SAME is return #("KeyRelease") end;
-- Modification routines
plus(c: CHAR): SAME pre c.is_alphanum is
-- Detail field. Only works for alphnumeric keys
verify_non_void(c.str);
return detail(c.str).has_detail(true);
end;
-- Common key events that correspond to special (non alpha-numeric) keys
-- Look at /usr/include/keysymdef.h
Return: SAME is return set_detail("Return") end;
Backspace: SAME is return set_detail("BackSpace") end;
Tab: SAME is return set_detail("Tab") end;
Linefeed: SAME is return set_detail("Linefeed") end;
Pause: SAME is return set_detail("Pause") end;
ScrollLock: SAME is return set_detail("Scroll_Lock") end;
Escape: SAME is return set_detail("Escape") end;
Delete: SAME is return set_detail("Delete") end;
Home: SAME is return set_detail("Home") end;
Left: SAME is return set_detail("Left") end;
Right: SAME is return set_detail("Right") end;
Prior: SAME is return set_detail("Prior") end;
Up: SAME is return set_detail("Up") end;
Down: SAME is return set_detail("Down") end;
Function(n: INT): SAME
pre n > 0 and n < 13
is
return set_detail("F"+n.str)
end;
Dollar: SAME is return set_detail("dollar") end;
Space: SAME is return set_detail("space") end;
Exclamation: SAME is return set_detail("exclam") end;
Percent: SAME is return set_detail("percent") end;
Ampersand: SAME is return set_detail("ampersand") end;
Apostrophe: SAME is return set_detail("apostrophe") end;
ParenLeft: SAME is return set_detail("parenleft") end;
ParenRight: SAME is return set_detail("parenright") end;
Asterisk: SAME is return set_detail("asterisk") end;
Plus: SAME is return set_detail("plus") end;
Quoteright: SAME is return set_detail("quoteright") end;
Comma: SAME is return set_detail("comma") end;
Minus: SAME is return set_detail("minus") end;
Period: SAME is return set_detail("period") end;
Slash: SAME is return set_detail("slash") end;
BracketLeft: SAME is return set_detail("bracketleft") end;
BracketRight: SAME is return set_detail("bracketright") end;
Backslash: SAME is return set_detail("backslash") end;
Underscore: SAME is return set_detail("underscore") end;
Grave: SAME is return set_detail("grave") end;
BraceLeft: SAME is return set_detail("braceleft") end;
BraceRight: SAME is return set_detail("braceright") end;
end; -- class TK_KEY_EVENT