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