before 3.39.
Improvements to X window event handling. The purpose of these
improvements is to permit Scheme to read X events from the queue
without immediately performing their actions; this supports looking
ahead in the queue to find interrupt characters in Edwin.
* X-DISPLAY-PROCESS-EVENTS no longer does anything special for
configure and exposure events that are received by xterm windows.
New primitives XTERM-RECONFIGURE and XTERM-DUMP-RECTANGLE must be
invoked by the Scheme event handler to get the same effect. New
event type `event_type_expose' is used to return exposure events.
* The coordinates and sizes returned in event objects are now in X
pixel units. New primitives XTERM-MAP-{X,Y}-{COORDINATE,SIZE} are
used to translate these units into xterm character coordinates.
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.74 1991/04/12 03:20:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.75 1991/04/26 05:25:11 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 74
+#define SUBVERSION 75
#endif
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.18 1991/03/14 23:03:03 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.19 1991/04/26 05:25:16 cph Exp $
Copyright (c) 1989-91 Massachusetts Institute of Technology
x_set_mouse_colors
(display, mouse_cursor, (attributes -> mouse_pixel), background_pixel);
XDefineCursor (display, window, mouse_cursor);
- XSelectInput
- (display, window,
- KeyPressMask | ExposureMask |
- ButtonPressMask | ButtonReleaseMask |
- StructureNotifyMask | FocusChangeMask |
- LeaveWindowMask | EnterWindowMask);
+ XSelectInput (display, window, 0);
xw =
(x_malloc (((sizeof (struct xwindow)) - (sizeof (xw -> extra))) + extra));
(XW_ALLOCATION_INDEX (xw)) = (allocate_table_index ((&x_window_table), xw));
event_type_key_press,
event_type_leave,
event_type_motion,
+ event_type_expose,
event_type_supremum
};
#define EVENT_0 2
#define EVENT_1 3
#define EVENT_2 4
+#define EVENT_3 5
+
+#define EVENT_INTEGER(event, slot, number) \
+ VECTOR_SET ((event), (slot), (long_to_integer (number)))
static SCHEME_OBJECT
DEFUN (make_event_object, (xw, type, extra),
VECTOR_SET (result, 1, (XW_TO_OBJECT (xw)));
return (result);
}
-
-static void
-DEFUN (standard_position, (xw, result, x, y),
- struct xwindow * xw AND
- SCHEME_OBJECT result AND
- int x AND
- int y)
-{
- int bx = (x - (XW_INTERNAL_BORDER_WIDTH (xw)));
- int by = (y - (XW_INTERNAL_BORDER_WIDTH (xw)));
- VECTOR_SET
- (result, EVENT_0,
- ((* (XW_X_COORDINATE_MAP (xw)))
- (xw,
- ((bx < 0) ? 0
- : (bx >= (XW_X_SIZE (xw))) ? ((XW_X_SIZE (xw)) - 1)
- : bx))));
- VECTOR_SET
- (result, EVENT_1,
- ((* (XW_Y_COORDINATE_MAP (xw)))
- (xw,
- ((by < 0) ? 0
- : (by >= (XW_Y_SIZE (xw))) ? ((XW_Y_SIZE (xw)) - 1)
- : by))));
-}
-
-static void
-DEFUN (standard_size, (xw, result, width, height),
- struct xwindow * xw AND
- SCHEME_OBJECT result AND
- int width AND
- int height)
-{
- width -= (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
- height -= (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
- VECTOR_SET
- (result, EVENT_0,
- ((* (XW_X_COORDINATE_MAP (xw))) (xw, ((width < 0) ? 0 : width))));
- VECTOR_SET
- (result, EVENT_1,
- ((* (XW_Y_COORDINATE_MAP (xw))) (xw, ((height < 0) ? 0 : height))));
-}
\f
static SCHEME_OBJECT
DEFUN (button_event, (xw, event, type),
enum event_type type)
{
SCHEME_OBJECT result = (make_event_object (xw, type, 3));
- standard_position (xw, result, (event -> x), (event -> y));
+ EVENT_INTEGER (result, EVENT_0, (event -> x));
+ EVENT_INTEGER (result, EVENT_1, (event -> y));
{
SCHEME_OBJECT conversion;
switch (event -> button)
if (EVENT_ENABLED (xw, event_type_motion))
{
result = (make_event_object (xw, event_type_motion, 2));
- standard_position
- (xw, result, ((event -> xmotion) . x), ((event -> xmotion) . y));
+ EVENT_INTEGER (result, EVENT_0, ((event -> xmotion) . x));
+ EVENT_INTEGER (result, EVENT_1, ((event -> xmotion) . y));
}
break;
case ConfigureNotify:
if (EVENT_ENABLED (xw, event_type_configure))
{
result = (make_event_object (xw, event_type_configure, 2));
- standard_size (xw,
- result,
- ((event -> xconfigure) . width),
- ((event -> xconfigure) . height));
+ EVENT_INTEGER (result, EVENT_0, ((event -> xconfigure) . width));
+ EVENT_INTEGER (result, EVENT_1, ((event -> xconfigure) . height));
+ }
+ break;
+ case Expose:
+ if (EVENT_ENABLED (xw, event_type_expose))
+ {
+ result = (make_event_object (xw, event_type_expose, 4));
+ EVENT_INTEGER (result, EVENT_0, ((event -> xexpose) . x));
+ EVENT_INTEGER (result, EVENT_1, ((event -> xexpose) . y));
+ EVENT_INTEGER (result, EVENT_2, ((event -> xexpose) . width));
+ EVENT_INTEGER (result, EVENT_3, ((event -> xexpose) . height));
+ }
+ break;
+ case GraphicsExpose:
+ if (EVENT_ENABLED (xw, event_type_expose))
+ {
+ result = (make_event_object (xw, event_type_expose, 4));
+ EVENT_INTEGER (result, EVENT_0, ((event -> xgraphicsexpose) . x));
+ EVENT_INTEGER (result, EVENT_1, ((event -> xgraphicsexpose) . y));
+ EVENT_INTEGER (result, EVENT_2,
+ ((event -> xgraphicsexpose) . width));
+ EVENT_INTEGER (result, EVENT_3,
+ ((event -> xgraphicsexpose) . height));
}
break;
case EnterNotify:
static void
DEFUN (update_input_mask, (xw), struct xwindow * xw)
{
- long event_mask = (ExposureMask | StructureNotifyMask);
+ long event_mask = 0;
+ if (EVENT_ENABLED (xw, event_type_expose))
+ event_mask |= ExposureMask;
+ if (EVENT_ENABLED (xw, event_type_configure))
+ event_mask |= StructureNotifyMask;
if (EVENT_ENABLED (xw, event_type_button_down))
event_mask |= ButtonPressMask;
if (EVENT_ENABLED (xw, event_type_button_up))
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.8 1991/04/15 16:14:09 jinx Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.9 1991/04/26 05:25:22 cph Exp $
-Copyright (c) 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1989-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
wm_set_size_hint (xw, geometry_mask, x_pos, y_pos);
XStoreName (display, window, "scheme-graphics");
XSetIconName (display, window, "scheme-graphics");
+ XSelectInput (display, window, StructureNotifyMask);
if ((ARG_REF (3)) == SHARP_F)
{
XMapWindow (display, window);
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11term.c,v 1.14 1990/11/14 17:05:25 cph Rel $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11term.c,v 1.15 1991/04/26 05:25:28 cph Exp $
-Copyright (c) 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1989-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
(XW_CURSOR_VISIBLE_P (xw)) = 1;
}
}
+
+static void
+DEFUN (xterm_process_event, (xw, event),
+ struct xwindow * xw AND
+ XEvent * event)
+{
+}
\f
static void
DEFUN (xterm_wm_set_size_hint, (xw, geometry_mask, x, y),
#define MIN(x, y) (((x) < (y)) ? (x) : (y))
static void
-DEFUN (xterm_process_configure_notify_event, (xw, event),
+DEFUN (xterm_reconfigure, (xw, width, height),
struct xwindow * xw AND
- XConfigureEvent * event)
+ unsigned int width AND
+ unsigned int height)
{
unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
- unsigned int x_size =
- (((event -> width) < extra) ? 0 : ((event -> width) - extra));
- unsigned int y_size =
- (((event -> height) < extra) ? 0 : ((event -> height) - extra));
+ unsigned int x_size = ((width < extra) ? 0 : (width - extra));
+ unsigned int y_size = ((height < extra) ? 0 : (height - extra));
if ((x_size != (XW_X_SIZE (xw))) || (y_size != (XW_Y_SIZE (xw))))
{
unsigned int x_csize = (x_size / (FONT_WIDTH (XW_FONT (xw))));
}
}
\f
-static void
-DEFUN (xterm_process_event, (xw, event),
- struct xwindow * xw AND
- XEvent * event)
+DEFINE_PRIMITIVE ("XTERM-RECONFIGURE", Prim_xterm_reconfigure, 3, 3, 0)
{
- switch (event -> type)
- {
- case ConfigureNotify:
- xterm_process_configure_notify_event (xw, (& (event -> xconfigure)));
- break;
- case Expose:
- xterm_dump_rectangle (xw,
- ((event -> xexpose) . x),
- ((event -> xexpose) . y),
- ((event -> xexpose) . width),
- ((event -> xexpose) . height));
- break;
- case GraphicsExpose:
- xterm_dump_rectangle (xw,
- ((event -> xgraphicsexpose) . x),
- ((event -> xgraphicsexpose) . y),
- ((event -> xgraphicsexpose) . width),
- ((event -> xgraphicsexpose) . height));
- break;
- }
+ PRIMITIVE_HEADER (3);
+ xterm_reconfigure ((x_window_arg (1)),
+ (arg_nonnegative_integer (2)),
+ (arg_nonnegative_integer (3)));
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("XTERM-DUMP-RECTANGLE", Prim_xterm_dump_rectangle, 5, 5, 0)
+{
+ PRIMITIVE_HEADER (5);
+ xterm_dump_rectangle ((x_window_arg (1)),
+ (arg_nonnegative_integer (2)),
+ (arg_nonnegative_integer (3)),
+ (arg_nonnegative_integer (4)),
+ (arg_nonnegative_integer (5)));
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+
+DEFINE_PRIMITIVE ("XTERM-MAP-X-COORDINATE", Prim_xterm_map_x_coordinate, 2, 2, 0)
+{
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int xp = (arg_nonnegative_integer (2));
+ int bx = (xp - (XW_INTERNAL_BORDER_WIDTH (xw)));
+ PRIMITIVE_RETURN
+ (long_to_integer
+ (((bx < 0) ? 0
+ : (bx >= (XW_X_SIZE (xw))) ? ((XW_X_SIZE (xw)) - 1)
+ : bx)
+ / (FONT_WIDTH (XW_FONT (xw)))));
+ }
+}
+
+DEFINE_PRIMITIVE ("XTERM-MAP-Y-COORDINATE", Prim_xterm_map_y_coordinate, 2, 2, 0)
+{
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int yp = (arg_nonnegative_integer (2));
+ int by = (yp - (XW_INTERNAL_BORDER_WIDTH (xw)));
+ PRIMITIVE_RETURN
+ (long_to_integer
+ (((by < 0) ? 0
+ : (by >= (XW_Y_SIZE (xw))) ? ((XW_Y_SIZE (xw)) - 1)
+ : by)
+ / (FONT_HEIGHT (XW_FONT (xw)))));
+ }
+}
+
+DEFINE_PRIMITIVE ("XTERM-MAP-X-SIZE", Prim_xterm_map_x_size, 2, 2, 0)
+{
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ int width =
+ ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
+ PRIMITIVE_RETURN
+ (long_to_integer
+ ((width < 0) ? 0 : (width / (FONT_WIDTH (XW_FONT (xw))))));
+ }
+}
+
+DEFINE_PRIMITIVE ("XTERM-MAP-Y-SIZE", Prim_xterm_map_y_size, 2, 2, 0)
+{
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ int height =
+ ((arg_nonnegative_integer (2)) - (2 * (XW_INTERNAL_BORDER_WIDTH (xw))));
+ PRIMITIVE_RETURN
+ (long_to_integer
+ ((height < 0) ? 0 : (height / (FONT_HEIGHT (XW_FONT (xw))))));
+ }
}
\f
DEFINE_PRIMITIVE ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3, 0)
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.74 1991/04/12 03:20:58 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.75 1991/04/26 05:25:11 cph Exp $
Copyright (c) 1988-91 Massachusetts Institute of Technology
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 74
+#define SUBVERSION 75
#endif
projects / mit-scheme.git / commitdiff