of several bugs, general reformatting of code.
Requires runtime version 14.97 or later, and edwin 3.21 or later.
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/starbasx.c,v 1.3 1989/09/20 23:11:43 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/starbasx.c,v 1.4 1990/10/02 22:52:12 cph Rel $
-Copyright (c) 1989 Massachusetts Institute of Technology
+Copyright (c) 1989, 1990 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
"Given a window, returns the name of a file which can be opened\n\
as a Starbase graphics device.")
{
- struct xwindow * xw;
- char * starbase_filename;
PRIMITIVE_HEADER (1);
-
- xw = (WINDOW_ARG (1));
- starbase_filename =
- (make_X11_gopen_string ((XW_DISPLAY (xw)), (XW_WINDOW (xw))));
- PRIMITIVE_RETURN
- ((starbase_filename == ((char *) 0))
- ? SHARP_F
- : (char_pointer_to_string (starbase_filename)));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ char * starbase_filename =
+ (make_X11_gopen_string ((XW_DISPLAY (xw)), (XW_WINDOW (xw))));
+ PRIMITIVE_RETURN
+ ((starbase_filename == 0)
+ ? SHARP_F
+ : (char_pointer_to_string (starbase_filename)));
+ }
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.28 1990/08/17 21:00:39 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/unxutl/Attic/ymkfile,v 1.29 1990/10/02 22:52:47 cph Exp $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
#endif
#ifdef HAVE_X_WINDOWS
-X_SOURCES = x11base.c x11term.c x11xtra.c x11graph.c
-X_OBJECTS = x11base.o x11term.o x11xtra.o x11graph.o
+X_SOURCES = x11base.c x11term.c x11graph.c
+X_OBJECTS = x11base.o x11term.o x11graph.o
X_LIB = LIBX11_MACHINE LIBX11_SYSTEM -lX11
#endif /* HAVE_X_WINDOWS */
dmpwrld.o : unexec.c getpagesize.h
-x11base.o x11graph.o : scheme.touch prims.h x11.h ux.h
-x11term.o x11xtra.o : scheme.touch prims.h x11.h x11term.h
+x11base.o x11graph.o x11term.o starbasex.o : scheme.touch prims.h x11.h
+x11base.o : ux.h
cterm.o : scheme.touch prims.h
starbase.o : scheme.touch prims.h
-starbasex.o : scheme.touch prims.h x11.h
-
-Xrep.o : scheme.touch prims.h Xlib.h
-Xlib.o : scheme.touch prims.h Xlib.h
Sgraph.o Sgraph_xt.o SgX.o : scheme.touch prims.h Sgraph.h
Sgraph_ar.o : scheme.touch prims.h Sgraph.h array.h
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.44 1990/09/11 19:50:29 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.45 1990/10/02 22:52:17 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
MIT in each case. */
/* This file contains version information for the microcode. */
-\f
+
/* Scheme system release version */
#ifndef RELEASE
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 44
+#define SUBVERSION 45
#endif
#ifndef UCODE_TABLES_FILENAME
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11.h,v 1.7 1990/08/16 19:23:35 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11.h,v 1.8 1990/10/02 22:52:22 cph Rel $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
#include <X11/Xutil.h>
#include "ansidecl.h"
\f
-struct allocation_table
+struct xdisplay
{
- char ** items;
- int length;
+ unsigned int allocation_index;
+ Display * display;
+ XEvent cached_event;
+ char cached_event_p;
};
+#define XD_ALLOCATION_INDEX(xd) ((xd) -> allocation_index)
+#define XD_DISPLAY(xd) ((xd) -> display)
+#define XD_CACHED_EVENT(xd) ((xd) -> cached_event)
+#define XD_CACHED_EVENT_P(xd) ((xd) -> cached_event_p)
+#define XD_TO_OBJECT(xd) (LONG_TO_UNSIGNED_FIXNUM (XD_ALLOCATION_INDEX (xd)))
+
struct drawing_attributes
{
/* Width of the borders, in pixels. */
unsigned long mouse_pixel;
};
-struct event_queue_element
-{
- XEvent event;
- struct event_queue_element * next;
-};
+#ifdef __STDC__
+/* This incomplete type definition is needed because the scope of the
+ implicit definition in the following typedefs is incorrect. */
+struct xwindow;
+#endif
+
+typedef void EXFUN ((*x_deallocator_t), (struct xwindow *));
+typedef void EXFUN ((*x_event_processor_t), (struct xwindow *, XEvent *));
+typedef SCHEME_OBJECT EXFUN
+ ((*x_coordinate_map_t), (struct xwindow *, unsigned int));
-struct event_queue
+struct xwindow_methods
{
- struct event_queue_element * head;
- struct event_queue_element * tail;
-};
+ /* Deallocation procedure to do window-specific deallocation. */
+ x_deallocator_t deallocator;
+ /* Procedure to call on each received event. */
+ x_event_processor_t event_processor;
+
+ /* Procedures to map coordinates to Scheme objects. */
+ x_coordinate_map_t x_coordinate_map;
+ x_coordinate_map_t y_coordinate_map;
+};
+\f
struct xwindow
{
- Display * display;
+ unsigned int allocation_index;
Window window;
+ struct xdisplay * xd;
/* Dimensions of the drawing region in pixels. */
- int x_size;
- int y_size;
+ unsigned int x_size;
+ unsigned int y_size;
/* The clip rectangle. */
- int clip_x;
- int clip_y;
- int clip_width;
- int clip_height;
+ unsigned int clip_x;
+ unsigned int clip_y;
+ unsigned int clip_width;
+ unsigned int clip_height;
struct drawing_attributes attributes;
/* The mouse cursor. */
Cursor mouse_cursor;
- /* Event queue for this window. */
- struct event_queue events;
-
- /* Flags that can be set by event handlers. */
- int event_flags;
+ struct xwindow_methods methods;
- /* Additional window-specific data. */
- char * extra;
+ unsigned long event_mask;
- /* Deallocation procedure to do window-specific deallocation. */
- void (* deallocator) ();
-
- /* Procedure to call on each received event (called with the
- xwindow and the event) */
- void (* event_proc) ();
-
- /* Nonzero iff this window is mapped. */
- char visible_p;
+#ifdef __GNUC__
+ PTR extra [0];
+#else
+ PTR extra [1];
+#endif
};
-\f
-extern struct allocation_table x_display_table;
-extern struct allocation_table x_window_table;
-extern int x_debug;
-extern int x_allocate_table_index ();
-extern char * x_allocation_item_arg ();
-extern int x_allocation_index_arg ();
-extern PTR EXFUN (x_malloc, (unsigned int size));
-extern PTR EXFUN (x_realloc, (PTR ptr, unsigned int size));
-extern unsigned long x_decode_color ();
-extern char * x_get_default ();
-extern unsigned long x_default_color ();
-extern void x_set_mouse_colors ();
-extern void x_default_attributes ();
-extern struct xwindow * x_make_window ();
-extern SCHEME_OBJECT x_window_to_object ();
-extern struct xwindow * x_window_to_xw ();
-extern Display * x_close_window ();
-extern void x_close_display ();
-extern void xw_enqueue_event ();
-extern int xw_dequeue_event ();
-extern int x_distribute_events ();
-extern void xw_wait_for_window_event ();
-extern int check_button ();
-extern int x_process_events ();
-extern int x_wait_for_event ();
-
-#define DISPLAY_ARG(arg) \
- ((Display *) (x_allocation_item_arg (arg, (& x_display_table))))
-
-#define WINDOW_ARG(arg) \
- ((struct xwindow *) (x_allocation_item_arg (arg, (& x_window_table))))
-
-#define XW_DISPLAY(xw) ((xw) -> display)
+#define XW_ALLOCATION_INDEX(xw) ((xw) -> allocation_index)
+#define XW_XD(xw) ((xw) -> xd)
#define XW_WINDOW(xw) ((xw) -> window)
#define XW_X_SIZE(xw) ((xw) -> x_size)
#define XW_Y_SIZE(xw) ((xw) -> y_size)
#define XW_REVERSE_GC(xw) ((xw) -> reverse_gc)
#define XW_CURSOR_GC(xw) ((xw) -> cursor_gc)
#define XW_MOUSE_CURSOR(xw) ((xw) -> mouse_cursor)
-#define XW_EVENT_FLAGS(xw) ((xw) -> event_flags)
-#define XW_VISIBLE_P(xw) ((xw) -> visible_p)
+#define XW_DEALLOCATOR(xw) (((xw) -> methods) . deallocator)
+#define XW_EVENT_PROCESSOR(xw) (((xw) -> methods) . event_processor)
+#define XW_X_COORDINATE_MAP(xw) (((xw) -> methods) . x_coordinate_map)
+#define XW_Y_COORDINATE_MAP(xw) (((xw) -> methods) . y_coordinate_map)
+#define XW_EVENT_MASK(xw) ((xw) -> event_mask)
+
+#define XW_TO_OBJECT(xw) (LONG_TO_UNSIGNED_FIXNUM (XW_ALLOCATION_INDEX (xw)))
+#define XW_DISPLAY(xw) (XD_DISPLAY (XW_XD (xw)))
#define FONT_WIDTH(f) (((f) -> max_bounds) . width)
#define FONT_HEIGHT(f) (((f) -> ascent) + ((f) -> descent))
#define FONT_BASE(f) ((f) -> ascent)
+\f
+extern int x_debug;
-#define XTERM_X_PIXEL(xw, x) \
- (((x) * (FONT_WIDTH (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
-
-#define XTERM_Y_PIXEL(xw, y) \
- (((y) * (FONT_HEIGHT (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
-
-#define XTERM_X_CHARACTER(xw, x) \
- (((x) - (XW_INTERNAL_BORDER_WIDTH (xw))) / (FONT_WIDTH (XW_FONT (xw))))
-
-#define XTERM_Y_CHARACTER(xw, y) \
- (((y) - (XW_INTERNAL_BORDER_WIDTH (xw))) / (FONT_HEIGHT (XW_FONT (xw))))
-
-#define EVENT_TYPE_UNKNOWN 0
-#define EVENT_TYPE_RESIZED 1
-#define EVENT_TYPE_BUTTON_DOWN 2
-#define EVENT_TYPE_BUTTON_UP 3
-#define EVENT_TYPE_FOCUS_IN 4
-#define EVENT_TYPE_FOCUS_OUT 5
-#define EVENT_TYPE_ENTER 6
-#define EVENT_TYPE_LEAVE 7
-#define EVENT_TYPE_MOTION 8
-#define EVENT_TYPE_CONFIGURE 9
-#define EVENT_TYPE_MAP 10
-#define EVENT_TYPE_UNMAP 11
-#define EVENT_TYPE_EXPOSE 12
-#define EVENT_TYPE_NO_EXPOSE 13
-#define EVENT_TYPE_GRAPHICS_EXPOSE 14
-#define EVENT_TYPE_KEY_PRESS 15
-
-#define EVENT_FLAG_RESIZED (1 << (EVENT_TYPE_RESIZED - 1))
-#define EVENT_FLAG_BUTTON_DOWN (1 << (EVENT_TYPE_BUTTON_DOWN - 1))
-#define EVENT_FLAG_BUTTON_UP (1 << (EVENT_TYPE_BUTTON_UP - 1))
-#define EVENT_FLAG_FOCUS_IN (1 << (EVENT_TYPE_FOCUS_IN - 1))
-#define EVENT_FLAG_FOCUS_OUT (1 << (EVENT_TYPE_FOCUS_OUT - 1))
-#define EVENT_FLAG_ENTER (1 << (EVENT_TYPE_ENTER - 1))
-#define EVENT_FLAG_LEAVE (1 << (EVENT_TYPE_LEAVE - 1))
-#define EVENT_FLAG_MOTION (1 << (EVENT_TYPE_MOTION - 1))
-#define EVENT_FLAG_CONFIGURE (1 << (EVENT_TYPE_CONFIGURE - 1))
-#define EVENT_FLAG_MAP (1 << (EVENT_TYPE_MAP - 1))
-#define EVENT_FLAG_UNMAP (1 << (EVENT_TYPE_UNMAP - 1))
-#define EVENT_FLAG_EXPOSE (1 << (EVENT_TYPE_EXPOSE - 1))
-#define EVENT_FLAG_NO_EXPOSE (1 << (EVENT_TYPE_NO_EXPOSE - 1))
-#define EVENT_FLAG_GRAPHICS_EXPOSE (1 << (EVENT_TYPE_GRAPHICS_EXPOSE - 1))
-#define EVENT_FLAG_KEY_PRESS (1 << (EVENT_TYPE_KEY_PRESS - 1))
-
-#define BITS_PER_INT 32 /* this should be somewhere else */
-
-#define SET_X_SELECT_MASK(fd) \
-{ \
- (x_select_mask) [fd / BITS_PER_INT] |= (1 << (fd % BITS_PER_INT)); \
-}
+extern struct xdisplay * EXFUN (x_display_arg, (unsigned int arg));
+extern struct xwindow * EXFUN (x_window_arg, (unsigned int arg));
+extern PTR EXFUN (x_malloc, (unsigned int size));
+extern PTR EXFUN (x_realloc, (PTR ptr, unsigned int size));
+extern SCHEME_OBJECT EXFUN (x_window_to_object, (struct xwindow * xw));
+
+extern char * EXFUN
+ (x_get_default,
+ (Display * display,
+ char * resource_name,
+ char * property_name,
+ char * class_name,
+ char * sdefault));
+
+extern void EXFUN
+ (x_default_attributes,
+ (Display * display,
+ char * resource_name,
+ struct drawing_attributes * attributes));
+
+extern struct xwindow * EXFUN
+ (x_make_window,
+ (struct xdisplay * xd,
+ Window window,
+ int x_size,
+ int y_size,
+ struct drawing_attributes * attributes,
+ struct xwindow_methods * methods,
+ unsigned int extra));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.14 1990/09/11 19:49:54 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.15 1990/10/02 22:52:26 cph Rel $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
#include "ux.h"
#include "x11.h"
+int x_debug = 0;
+static int initialization_done = 0;
+
+#define INITIALIZE_ONCE() \
+{ \
+ if (!initialization_done) \
+ initialize_once (); \
+}
+
+static void EXFUN (initialize_once, (void));
+
PTR
DEFUN (x_malloc, (size), unsigned int size)
{
return (result);
}
\f
-int
-x_allocate_table_index (table, item)
- struct allocation_table * table;
- char * item;
+struct allocation_table
{
- char ** items = (table -> items);
- int length = (table -> length);
- int i;
+ PTR * items;
+ int length;
+};
+
+static struct allocation_table x_display_table;
+static struct allocation_table x_window_table;
+
+static void
+DEFUN (allocation_table_initialize, (table), struct allocation_table * table)
+{
+ (table -> length) = 0;
+}
+static unsigned int
+DEFUN (allocate_table_index, (table, item),
+ struct allocation_table * table AND
+ PTR item)
+{
+ unsigned int length = (table -> length);
+ unsigned int new_length;
+ PTR * items = (table -> items);
+ PTR * new_items;
+ PTR * scan;
+ PTR * end;
if (length == 0)
{
- int new_length = 4;
- char ** new_items = (x_malloc ((sizeof (char *)) * new_length));
- (new_items [0]) = item;
- for (i = 1; (i < new_length); i += 1)
- (new_items [i]) = ((char *) 0);
- (table -> items) = new_items;
- (table -> length) = new_length;
- return (0);
+ new_length = 4;
+ new_items = (x_malloc ((sizeof (PTR)) * new_length));
}
- for (i = 0; (i < length); i += 1)
- if ((items [i]) == ((char *) 0))
- {
- (items [i]) = item;
- return (i);
- }
- {
- int new_length = (length * 2);
- char ** new_items = (x_realloc (items, ((sizeof (char *)) * new_length)));
- (new_items [length]) = item;
- for (i = (length + 1); (i < new_length); i += 1)
- (new_items [i]) = ((char *) 0);
- (table -> items) = new_items;
- (table -> length) = new_length;
- }
+ else
+ {
+ scan = items;
+ end = (scan + length);
+ while (scan < end)
+ if ((*scan++) == 0)
+ {
+ (*--scan) = item;
+ return (scan - items);
+ }
+ new_length = (length * 2);
+ new_items = (x_realloc (items, ((sizeof (PTR)) * new_length)));
+ }
+ scan = (new_items + length);
+ end = (new_items + new_length);
+ (*scan++) = item;
+ while (scan < end)
+ (*scan++) = 0;
+ (table -> items) = new_items;
+ (table -> length) = new_length;
return (length);
}
-#define DEF_ALLOCATION_ARG(name, result_type, result) \
-result_type \
-name (arg, table) \
- int arg; \
- struct allocation_table * table; \
-{ \
- fast SCHEME_OBJECT object = (ARG_REF (arg)); \
- \
- if (! (FIXNUM_P (object))) \
- error_wrong_type_arg (arg); \
- if (! (FIXNUM_NEGATIVE_P (object))) \
- { \
- fast int length = (table -> length); \
- fast char ** items = (table -> items); \
- fast int index = (UNSIGNED_FIXNUM_TO_LONG (object)); \
- if ((index < length) && ((items [index]) != ((char *) 0))) \
- return (result); \
- } \
- error_bad_range_arg (arg); \
- /* NOTREACHED */ \
-}
-
-DEF_ALLOCATION_ARG (x_allocation_item_arg, char *, (items [index]))
-DEF_ALLOCATION_ARG (x_allocation_index_arg, int, index)
-
-struct allocation_table x_display_table;
-struct allocation_table x_window_table;
-\f
-int x_debug = 0;
-
-DEFINE_PRIMITIVE ("X-DEBUG", Prim_x_debug, 1, 1, 0)
+static PTR
+DEFUN (allocation_item_arg, (arg, table),
+ unsigned int arg AND
+ struct allocation_table * table)
{
- PRIMITIVE_HEADER (1);
+ unsigned int index = (arg_index_integer (arg, (table -> length)));
+ PTR item = ((table -> items) [index]);
+ if (item == 0)
+ error_bad_range_arg (arg);
+ return (item);
+}
- x_debug = ((ARG_REF (1)) != SHARP_F);
- PRIMITIVE_RETURN (UNSPECIFIC);
+struct xdisplay *
+DEFUN (x_display_arg, (arg), unsigned int arg)
+{
+ INITIALIZE_ONCE ();
+ return (allocation_item_arg (arg, (&x_display_table)));
}
+struct xwindow *
+DEFUN (x_window_arg, (arg), unsigned int arg)
+{
+ INITIALIZE_ONCE ();
+ return (allocation_item_arg (arg, (&x_window_table)));
+}
+\f
static int
-x_io_error_handler (display)
- Display * display;
+DEFUN (x_io_error_handler, (display), Display * display)
{
fprintf (stderr, "\nX IO Error\n");
error_external_return ();
}
static int
-x_error_handler (display, error_event)
- Display * display;
- XErrorEvent * error_event;
+DEFUN (x_error_handler, (display, error_event),
+ Display * display AND
+ XErrorEvent * error_event)
{
char buffer [2048];
-
XGetErrorText (display, (error_event -> error_code),
buffer, (sizeof (buffer)));
fprintf (stderr, "\nX Error: %s\n", buffer);
fprintf (stderr, " Request code: %d\n",
(error_event -> request_code));
fprintf (stderr, " Error serial: %x\n", (error_event -> serial));
+ fflush (stderr);
error_external_return ();
}
-
-unsigned long
-x_decode_color (display, color_map, color_name, default_color)
- Display * display;
- Colormap color_map;
- char * color_name;
- unsigned long default_color;
+\f
+static int
+DEFUN (x_decode_color, (display, color_map, color_name, color_return),
+ Display * display AND
+ Colormap color_map AND
+ char * color_name AND
+ unsigned long * color_return)
{
XColor cdef;
+ if ((XParseColor (display, color_map, color_name, (&cdef)))
+ && (XAllocColor (display, color_map, (&cdef))))
+ {
+ (*color_return) = (cdef . pixel);
+ return (1);
+ }
+ return (0);
+}
- if ((strcmp (color_name, "black")) == 0)
- return (BlackPixel (display, (DefaultScreen (display))));
- if ((strcmp (color_name, "white")) == 0)
- return (WhitePixel (display, (DefaultScreen (display))));
- if (DisplayCells (display, (DefaultScreen (display))) <= 2)
- return (default_color);
- if ((XParseColor (display, color_map, color_name, (& cdef))) &&
- (XAllocColor (display, color_map, (& cdef))))
- return (cdef . pixel);
- return (default_color);
+static unsigned long
+DEFUN (arg_color, (arg, display),
+ unsigned int arg AND
+ Display * display)
+{
+ unsigned long result;
+ if (! (x_decode_color
+ (display,
+ (DefaultColormap (display, (DefaultScreen (display)))),
+ (STRING_ARG (arg)),
+ (&result))))
+ error_bad_range_arg (arg);
+ return (result);
}
-\f
-char *
-x_get_default (display, resource_name, property_name, class_name, sdefault)
- Display * display;
- char * resource_name;
- char * property_name;
- char * class_name;
- char * sdefault;
+
+static void
+DEFUN (x_set_mouse_colors,
+ (display, mouse_cursor, mouse_pixel, background_pixel),
+ Display * display AND
+ Cursor mouse_cursor AND
+ unsigned long mouse_pixel AND
+ unsigned long background_pixel)
{
- char * result;
+ Colormap color_map = (DefaultColormap (display, (DefaultScreen (display))));
+ XColor mouse_color;
+ XColor background_color;
+ (mouse_color . pixel) = mouse_pixel;
+ XQueryColor (display, color_map, (&mouse_color));
+ (background_color . pixel) = background_pixel;
+ XQueryColor (display, color_map, (&background_color));
+ XRecolorCursor (display, mouse_cursor, (&mouse_color), (&background_color));
+}
- result = (XGetDefault (display, resource_name, property_name));
- if (result != ((char *) 0))
+char *
+DEFUN (x_get_default,
+ (display, resource_name, property_name, class_name, sdefault),
+ Display * display AND
+ char * resource_name AND
+ char * property_name AND
+ char * class_name AND
+ char * sdefault)
+{
+ char * result = (XGetDefault (display, resource_name, property_name));
+ if (result != 0)
return (result);
result = (XGetDefault (display, resource_name, class_name));
- if (result != ((char *) 0))
+ if (result != 0)
return (result);
return (sdefault);
}
-
-unsigned long
-x_default_color (display, resource_name, property_name, class_name,
- default_color)
- Display * display;
- char * resource_name;
- char * property_name;
- char * class_name;
- unsigned long default_color;
+\f
+static unsigned long
+DEFUN (x_default_color,
+ (display, resource_name, property_name, class_name, default_color),
+ Display * display AND
+ char * resource_name AND
+ char * property_name AND
+ char * class_name AND
+ unsigned long default_color)
{
char * color_name =
- (x_get_default
- (display, resource_name, property_name, class_name, ((char *) 0)));
- if (color_name == ((char *) 0))
- return (default_color);
+ (x_get_default (display, resource_name, property_name, class_name, 0));
+ unsigned long result;
return
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- color_name,
- default_color));
+ (((color_name != 0)
+ && (x_decode_color
+ (display,
+ (DefaultColormap (display, (DefaultScreen (display)))),
+ color_name,
+ (&result))))
+ ? result
+ : default_color);
}
void
-x_set_mouse_colors (display, mouse_cursor, mouse_pixel, background_pixel)
- Display * display;
- Cursor mouse_cursor;
- unsigned long mouse_pixel;
- unsigned long background_pixel;
-{
- Colormap color_map = (DefaultColormap (display, (DefaultScreen (display))));
- XColor mouse_color;
- XColor background_color;
-
- (mouse_color . pixel) = mouse_pixel;
- XQueryColor (display, color_map, (& mouse_color));
- (background_color . pixel) = background_pixel;
- XQueryColor (display, color_map, (& background_color));
- XRecolorCursor
- (display, mouse_cursor, (& mouse_color), (& background_color));
- return;
-}
-\f
-void
-x_default_attributes (display, resource_name, attributes)
- Display * display;
- char * resource_name;
- struct drawing_attributes * attributes;
+DEFUN (x_default_attributes, (display, resource_name, attributes),
+ Display * display AND
+ char * resource_name AND
+ struct drawing_attributes * attributes)
{
int screen_number = (DefaultScreen (display));
-
(attributes -> font) =
(XLoadQueryFont
(display,
- (x_get_default
- (display, resource_name, "font", "Font", "9x15"))));
- if ((attributes -> font) == ((XFontStruct *) 0))
+ (x_get_default (display, resource_name, "font", "Font", "9x15"))));
+ if ((attributes -> font) == 0)
error_external_return ();
{
char * s =
(x_get_default
- (display, resource_name, "borderWidth", "BorderWidth", ((char *) 0)));
- (attributes -> border_width) = ((s == ((char *) 0)) ? 2 : (atoi (s)));
+ (display, resource_name, "borderWidth", "BorderWidth", 0));
+ (attributes -> border_width) = ((s == 0) ? 2 : (atoi (s)));
}
{
char * s =
(x_get_default
- (display, resource_name,
- "internalBorder", "BorderWidth", ((char *) 0)));
+ (display, resource_name, "internalBorder", "BorderWidth", 0));
(attributes -> internal_border_width) =
- ((s == ((char *) 0)) ? (attributes -> border_width) : (atoi (s)));
+ ((s == 0) ? (attributes -> border_width) : (atoi (s)));
}
{
unsigned long white_pixel = (WhitePixel (display, screen_number));
unsigned long black_pixel = (BlackPixel (display, screen_number));
unsigned long foreground_pixel;
-
(attributes -> background_pixel) =
(x_default_color
(display, resource_name, "background", "Background", white_pixel));
(display, resource_name,
"pointerColor", "Foreground", foreground_pixel));
}
- return;
}
\f
#define MAKE_GC(gc, fore, back) \
{ \
XGCValues gcv; \
- \
(gcv . font) = fid; \
(gcv . foreground) = (fore); \
(gcv . background) = (back); \
}
struct xwindow *
-x_make_window (display, window, x_size, y_size, attributes, extra, deallocator, event_proc)
- Display * display;
- Window window;
- int x_size;
- int y_size;
- struct drawing_attributes * attributes;
- int extra;
- void (* deallocator) ();
- void (* event_proc) ();
+DEFUN (x_make_window, (xd, window, x_size, y_size, attributes, methods, extra),
+ struct xdisplay * xd AND
+ Window window AND
+ int x_size AND
+ int y_size AND
+ struct drawing_attributes * attributes AND
+ struct xwindow_methods * methods AND
+ unsigned int extra)
{
GC normal_gc;
GC reverse_gc;
GC cursor_gc;
struct xwindow * xw;
+ Display * display = (XD_DISPLAY (xd));
Font fid = ((attributes -> font) -> fid);
unsigned long foreground_pixel = (attributes -> foreground_pixel);
unsigned long background_pixel = (attributes -> background_pixel);
Cursor mouse_cursor = (XCreateFontCursor (display, XC_left_ptr));
-
MAKE_GC (normal_gc, foreground_pixel, background_pixel);
MAKE_GC (reverse_gc, background_pixel, foreground_pixel);
MAKE_GC (cursor_gc, background_pixel, (attributes -> cursor_pixel));
x_set_mouse_colors
(display, mouse_cursor, (attributes -> mouse_pixel), background_pixel);
XDefineCursor (display, window, mouse_cursor);
-
- xw = (x_malloc (sizeof (struct xwindow)));
- (XW_DISPLAY (xw)) = display;
+ XSelectInput
+ (display, window,
+ KeyPressMask | ExposureMask |
+ ButtonPressMask | ButtonReleaseMask |
+ StructureNotifyMask | FocusChangeMask |
+ LeaveWindowMask | EnterWindowMask);
+ xw =
+ (x_malloc (((sizeof (struct xwindow)) - (sizeof (xw -> extra))) + extra));
+ (XW_ALLOCATION_INDEX (xw)) = (allocate_table_index ((&x_window_table), xw));
+ (XW_XD (xw)) = xd;
(XW_WINDOW (xw)) = window;
(XW_X_SIZE (xw)) = x_size;
(XW_Y_SIZE (xw)) = y_size;
(XW_CLIP_Y (xw)) = 0;
(XW_CLIP_WIDTH (xw)) = x_size;
(XW_CLIP_HEIGHT (xw)) = y_size;
- (xw -> attributes) = (* attributes);
+ (xw -> attributes) = (*attributes);
+ (xw -> methods) = (*methods);
(XW_NORMAL_GC (xw)) = normal_gc;
(XW_REVERSE_GC (xw)) = reverse_gc;
(XW_CURSOR_GC (xw)) = cursor_gc;
(XW_MOUSE_CURSOR (xw)) = mouse_cursor;
- ((xw -> events) . head) = ((struct event_queue_element *) 0);
- ((xw -> events) . tail) = ((struct event_queue_element *) 0);
- (XW_EVENT_FLAGS (xw)) = 0;
- (XW_VISIBLE_P (xw)) = 0;
-
- if (extra > 0)
- (xw -> extra) = (x_malloc (extra));
- (xw -> deallocator) = deallocator;
- (xw -> event_proc) = event_proc;
+ (XW_EVENT_MASK (xw)) = 0;
return (xw);
}
-
-SCHEME_OBJECT
-x_window_to_object (xw)
- struct xwindow * xw;
-{
- return
- (LONG_TO_UNSIGNED_FIXNUM
- (x_allocate_table_index ((& x_window_table), ((char *) xw))));
-}
\f
-struct xwindow *
-x_window_to_xw (window)
- Window window;
+static struct xwindow *
+DEFUN (x_window_to_xw, (window), Window window)
{
- int length = (x_window_table . length);
- struct xwindow ** items = ((struct xwindow **) (x_window_table . items));
- int i;
- struct xwindow * xw;
-
- for (i = 0; (i < length); i += 1)
+ struct xwindow ** scan = ((struct xwindow **) (x_window_table . items));
+ struct xwindow ** end = (scan + (x_window_table . length));
+ while (scan < end)
{
- xw = (items [i]);
+ struct xwindow * xw = (*scan++);
if ((XW_WINDOW (xw)) == window)
return (xw);
}
- return ((struct xwindow *) 0);
-}
-
-int
-x_window_to_xw_index (window)
- Window window;
-{
- int length = (x_window_table . length);
- struct xwindow ** items = ((struct xwindow **) (x_window_table . items));
- int i;
- struct xwindow * xw;
-
- for (i = 0; (i < length); i += 1)
- {
- xw = (items [i]);
- if ((XW_WINDOW (xw)) == window)
- return (i);
- }
- return (-1);
+ return (0);
}
-Display *
-x_close_window (index)
- int index;
+static void
+DEFUN (x_close_window, (xw), struct xwindow * xw)
{
- struct xwindow * xw;
- Display * display;
-
- xw = ((struct xwindow *) ((x_window_table . items) [index]));
- ((x_window_table . items) [index]) = 0;
- display = (XW_DISPLAY (xw));
+ Display * display = (XW_DISPLAY (xw));
+ ((x_window_table . items) [XW_ALLOCATION_INDEX (xw)]) = 0;
{
- void (* deallocator) () = (xw -> deallocator);
- if (deallocator != ((void (*) ()) 0))
- (* deallocator) (xw);
+ x_deallocator_t deallocator = (XW_DEALLOCATOR (xw));
+ if (deallocator != 0)
+ (*deallocator) (xw);
}
{
XFontStruct * font = (XW_FONT (xw));
- if (font != ((XFontStruct *) 0))
+ if (font != 0)
XFreeFont (display, font);
}
XDestroyWindow (display, (XW_WINDOW (xw)));
free (xw);
- return (display);
}
-void
-x_close_display (index)
- int index;
+static void
+DEFUN (x_close_display, (xd), struct xdisplay * xd)
{
- Display * display;
-
- display = ((Display *) ((x_display_table . items) [index]));
- ((x_display_table . items) [index]) = 0;
- {
- struct xwindow ** items = ((struct xwindow **) (x_window_table . items));
- int length = (x_window_table . length);
- int i;
-
- for (i = 0; (i < length); i += 1)
- {
- struct xwindow * xw = (items [i]);
- if ((xw != ((struct xwindow *) 0)) &&
- ((XW_DISPLAY (xw)) == display))
- (void) x_close_window (i);
- }
- }
- XCloseDisplay (display);
- return;
+ struct xwindow ** scan = ((struct xwindow **) (x_window_table . items));
+ struct xwindow ** end = (scan + (x_window_table . length));
+ while (scan < end)
+ {
+ struct xwindow * xw = (*scan++);
+ if ((xw != 0) && ((XW_XD (xw)) == xd))
+ x_close_window (xw);
+ }
+ ((x_display_table . items) [XD_ALLOCATION_INDEX (xd)]) = 0;
+ XCloseDisplay (XD_DISPLAY (xd));
}
-\f
-static struct event_queue global_x_event_queue;
-int
-x_process_events ()
+static void
+DEFUN_VOID (x_close_all_displays)
{
- Display ** displays;
- Display * display;
- int length;
- int i;
- int any_events_p = false;
-
- displays = ((Display **) (x_display_table . items));
- length = (x_display_table . length);
- for (i = 0; (i < length); ++i) {
- if ((display = displays [i]) != ((Display *) 0)) {
- any_events_p = x_distribute_events (display) || any_events_p;
+ struct xdisplay ** scan = ((struct xdisplay **) (x_display_table . items));
+ struct xdisplay ** end = (scan + (x_display_table . length));
+ while (scan < end)
+ {
+ struct xdisplay * xd = (*scan++);
+ if (xd != 0)
+ x_close_display (xd);
}
- }
- return (any_events_p);
}
-
+\f
static void
-x_enqueue_event (events, event)
- struct event_queue * events;
- XEvent * event;
-{
- struct event_queue_element * element;
- struct event_queue_element * global_element;
-
- element = (x_malloc (sizeof (struct event_queue_element)));
- (element -> event) = (* event);
- (element -> next) = ((struct event_queue_element *) 0);
- if ((events -> head) == ((struct event_queue_element *) 0))
- (events -> head) = element;
- else
- ((events -> tail) -> next) = element;
- (events -> tail) = element;
-
- global_element = (x_malloc (sizeof (struct event_queue_element)));
- (global_element -> event) = (* event);
- (global_element -> next) = ((struct event_queue_element *) 0);
- if ((global_x_event_queue . head) == ((struct event_queue_element *) 0))
- (global_x_event_queue . head) = global_element;
- else
- ((global_x_event_queue . tail) -> next) = global_element;
- (global_x_event_queue . tail) = global_element;
-
- return;
-}
-
-static int
-x_dequeue_event (events, event)
- struct event_queue * events;
- XEvent * event;
+DEFUN (xw_process_event, (xw, event),
+ struct xwindow * xw AND
+ XEvent * event)
{
- struct event_queue_element * element;
-
- element = (events -> head);
- if (element == ((struct event_queue_element *) 0))
- return (0);
- (* event) = (element -> event);
- (events -> head) = (element -> next);
- free (element);
- return (1);
+ if (x_debug)
+ {
+ char * type_name;
+ switch (event -> type)
+ {
+ case ButtonPress: type_name = "ButtonPress"; break;
+ case ButtonRelease: type_name = "ButtonRelease"; break;
+ case CirculateNotify: type_name = "CirculateNotify"; break;
+ case ConfigureNotify: type_name = "ConfigureNotify"; break;
+ case CreateNotify: type_name = "CreateNotify"; break;
+ case DestroyNotify: type_name = "DestroyNotify"; break;
+ case EnterNotify: type_name = "EnterNotify"; break;
+ case Expose: type_name = "Expose"; break;
+ case FocusIn: type_name = "FocusIn"; break;
+ case FocusOut: type_name = "FocusOut"; break;
+ case GraphicsExpose: type_name = "GraphicsExpose"; break;
+ case GravityNotify: type_name = "GravityNotify"; break;
+ case KeyPress: type_name = "KeyPress"; break;
+ case KeyRelease: type_name = "KeyRelease"; break;
+ case LeaveNotify: type_name = "LeaveNotify"; break;
+ case MapNotify: type_name = "MapNotify"; break;
+ case MappingNotify: type_name = "MappingNotify"; break;
+ case MotionNotify: type_name = "MotionNotify"; break;
+ case NoExpose: type_name = "NoExpose"; break;
+ case ReparentNotify: type_name = "ReparentNotify"; break;
+ case UnmapNotify: type_name = "UnmapNotify"; break;
+ default: type_name = 0; break;
+ }
+ fprintf (stderr, "\nX event: ");
+ if (type_name != 0)
+ fprintf (stderr, "%s", type_name);
+ else
+ fprintf (stderr, "%d", (event -> type));
+ fprintf (stderr, "\n");
+ fflush (stderr);
+ }
+ switch (event -> type)
+ {
+ case MappingNotify:
+ switch ((event -> xmapping) . request)
+ {
+ case MappingKeyboard:
+ case MappingModifier:
+ XRefreshKeyboardMapping (& (event -> xmapping));
+ break;
+ }
+ break;
+ }
+ (* (XW_EVENT_PROCESSOR (xw))) (xw, event);
}
+\f
+enum event_type
+{
+ event_type_button_down,
+ event_type_button_up,
+ event_type_configure,
+ event_type_enter,
+ event_type_focus_in,
+ event_type_focus_out,
+ event_type_key_press,
+ event_type_leave,
+ event_type_motion,
+ event_type_supremum
+};
+
+#define EVENT_MASK_ARG(arg) \
+ (arg_index_integer ((arg), (1 << ((unsigned int) event_type_supremum))))
+
+#define EVENT_ENABLED(xw, type) \
+ (((XW_EVENT_MASK (xw)) & (1 << ((unsigned int) (type)))) != 0)
+
+#define EVENT_0 2
+#define EVENT_1 3
+#define EVENT_2 4
-int
-x_dequeue_global_event (event)
- XEvent * event;
+static SCHEME_OBJECT
+DEFUN (make_event_object, (xw, type, extra),
+ struct xwindow * xw AND
+ enum event_type type AND
+ unsigned int extra)
{
- (void) x_process_events();
- if (x_dequeue_event ((& global_x_event_queue), event)) {
- return (1);
- }
- return (x_dequeue_event ((& global_x_event_queue), event));
+ SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, (2 + extra), 1));
+ VECTOR_SET (result, 0, (LONG_TO_UNSIGNED_FIXNUM ((long) type)));
+ VECTOR_SET (result, 1, (XW_TO_OBJECT (xw)));
+ return (result);
}
-void
-xw_enqueue_event (xw, event)
- struct xwindow * xw;
- XEvent * event;
+static void
+DEFUN (standard_position, (xw, result, x, y),
+ struct xwindow * xw AND
+ SCHEME_OBJECT result AND
+ int x AND
+ int y)
{
- x_enqueue_event ((& (xw -> events)), event);
- return;
+ 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))));
}
-int
-xw_dequeue_event (xw, event)
- struct xwindow * xw;
- XEvent * event;
+static void
+DEFUN (standard_size, (xw, result, width, height),
+ struct xwindow * xw AND
+ SCHEME_OBJECT result AND
+ int width AND
+ int height)
{
- if (x_dequeue_event ((& (xw -> events)), event))
- return (1);
- (void) x_distribute_events (XW_DISPLAY (xw));
- return (x_dequeue_event ((& (xw -> events)), event));
+ 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
-int
-x_distribute_events (display)
- Display * display;
-{
- int nevents;
- XEvent * event;
- struct xwindow * exw;
- int any_events_p;
-
- nevents = (XEventsQueued (display, QueuedAfterReading));
- any_events_p = (nevents ? true : false);
- while (nevents > 0)
- {
- event = (x_malloc (sizeof (XEvent)));
- XNextEvent (display, (event));
- nevents -= 1;
-
- exw = (x_window_to_xw ((event -> xany) . window));
- if (exw == ((struct xwindow *) 0))
- continue;
- (exw->event_proc)(exw, (event));
- xw_enqueue_event (exw, (event));
- }
- return (any_events_p);
-}
-
-void
-xw_wait_for_window_event (xw)
- struct xwindow * xw;
+static SCHEME_OBJECT
+DEFUN (button_event, (xw, event, type),
+ struct xwindow * xw AND
+ XButtonEvent * event AND
+ enum event_type type)
{
- Display * display = (XW_DISPLAY (xw));
- struct xwindow * exw;
- XEvent event_s;
- XEvent * event;
-
- event = &event_s;
-
- while (1)
- {
- XNextEvent (display, event);
-
- exw = (x_window_to_xw ((event -> xany) . window));
- if (exw != ((struct xwindow *) 0)) {
- (exw->event_proc)(exw, event);
- xw_enqueue_event (exw, event);
- if (exw == xw)
- {
- (void) x_distribute_events (display);
- break;
- }
+ SCHEME_OBJECT result = (make_event_object (xw, type, 3));
+ standard_position (xw, result, (event -> x), (event -> y));
+ {
+ SCHEME_OBJECT conversion;
+ switch (event -> button)
+ {
+ case Button1: conversion = (LONG_TO_UNSIGNED_FIXNUM (0)); break;
+ case Button2: conversion = (LONG_TO_UNSIGNED_FIXNUM (1)); break;
+ case Button3: conversion = (LONG_TO_UNSIGNED_FIXNUM (2)); break;
+ case Button4: conversion = (LONG_TO_UNSIGNED_FIXNUM (3)); break;
+ case Button5: conversion = (LONG_TO_UNSIGNED_FIXNUM (4)); break;
+ default: conversion = (SHARP_F); break;
}
- }
- return;
-}
-
-static int * x_select_mask;
-static int x_select_mask_size = 0;
-static int x_max_file_descriptor;
-
-int
-copy_x_select_mask (mask)
- int ** mask;
-{
- int i;
-
- (*mask) = (x_malloc (x_select_mask_size * sizeof (int)));
- for (i = 0; i < x_select_mask_size; i++) {
- (*mask) [i] = (x_select_mask) [i];
+ VECTOR_SET (result, EVENT_2, conversion);
}
- return (x_max_file_descriptor);
+ return (result);
}
-/* Note that because of the conditional use of select here we can't
- depend on x_wait_for_event() actually waiting for an event. The
- return value will tell you if an event actually was processed */
+static XComposeStatus compose_status;
-int
-x_wait_for_event ()
+static SCHEME_OBJECT
+DEFUN (key_event, (xw, event, type),
+ struct xwindow * xw AND
+ XKeyEvent * event AND
+ enum event_type type)
{
- int * select_mask;
- int max_filedesc;
- int any_events_p;
-
- any_events_p = x_process_events ();
-
-#ifdef HAVE_SELECT
- if (! any_events_p) {
- max_filedesc = copy_x_select_mask(&select_mask);
- UX_select ((1 +max_filedesc), select_mask, 0, 0, 0);
- any_events_p = x_process_events ();
- }
-#endif /* HAVE_SELECT */
-
- return (any_events_p);
-}
-\f
-#define MAKE_EVENT(event_type, window_index, extra) \
-(cons (LONG_TO_UNSIGNED_FIXNUM (event_type), \
- cons (((window_index < 0) ? \
- SHARP_F : \
- LONG_TO_UNSIGNED_FIXNUM (window_index)), \
- extra)))
-
-int
-check_button (button)
- int button;
-{
- switch (button)
+ char copy_buffer [80];
+ KeySym keysym;
+ int nbytes =
+ (XLookupString (event,
+ copy_buffer,
+ (sizeof (copy_buffer)),
+ (&keysym),
+ (&compose_status)));
+ if ((nbytes < 1)
+ || (IsFunctionKey (keysym))
+ || (IsCursorKey (keysym))
+ || (IsKeypadKey (keysym))
+ || (IsMiscFunctionKey (keysym))
+ || (IsPFKey (keysym))
+ || (IsModifierKey (keysym)))
+ return (SHARP_F);
+ else
{
- case Button1: return (0);
- case Button2: return (1);
- case Button3: return (2);
- case Button4: return (3);
- case Button5: return (4);
- default: return (-1);
+ SCHEME_OBJECT result = (make_event_object (xw, type, 1));
+ if ((nbytes == 1) && (((event -> state) & Mod1Mask) != 0))
+ (copy_buffer[0]) |= 0x80;
+ VECTOR_SET (result, EVENT_0, (memory_to_string (nbytes, copy_buffer)));
+ return (result);
}
}
-
+\f
static SCHEME_OBJECT
-x_event_to_scheme_event (event)
- XEvent * event;
+DEFUN (x_event_to_object, (event), XEvent * event)
{
- struct xwindow * exw;
- int xw_index;
-
- xw_index = x_window_to_xw_index ((event -> xany) . window);
- exw = (struct xwindow *) (x_window_table . items) [xw_index];
- switch (event -> type) {
-
- case ConfigureNotify:
- return (MAKE_EVENT (EVENT_TYPE_CONFIGURE, xw_index, SHARP_F));
- break;
-
- case MapNotify:
- return (MAKE_EVENT (EVENT_TYPE_MAP, xw_index, SHARP_F));
- break;
-
- case UnmapNotify:
- return (MAKE_EVENT (EVENT_TYPE_UNMAP, xw_index, SHARP_F));
- break;
-
- case Expose:
- return (MAKE_EVENT (EVENT_TYPE_EXPOSE, xw_index, SHARP_F));
- break;
-
- case GraphicsExpose:
- return (MAKE_EVENT (EVENT_TYPE_GRAPHICS_EXPOSE, xw_index, SHARP_F));
- break;
-
- case KeyPress:
+ struct xwindow * xw = (x_window_to_xw ((event -> xany) . window));
+ SCHEME_OBJECT result = SHARP_F;
+ switch (event -> type)
{
- char copy_buffer [80];
- KeySym keysym;
-
- XLookupString ((& (event -> xkey)),
- (& (copy_buffer [0])),
- (sizeof (copy_buffer)),
- (& keysym),
- ((XComposeStatus *) 0));
- return (MAKE_EVENT (EVENT_TYPE_KEY_PRESS,
- xw_index,
- cons(char_pointer_to_string (& (copy_buffer [0])),
- EMPTY_LIST)));
+ case KeyPress:
+ if (EVENT_ENABLED (xw, event_type_key_press))
+ result = (key_event (xw, (& (event -> xkey)), event_type_key_press));
+ break;
+ case ButtonPress:
+ if (EVENT_ENABLED (xw, event_type_button_down))
+ result =
+ (button_event (xw, (& (event -> xbutton)), event_type_button_down));
+ break;
+ case ButtonRelease:
+ if (EVENT_ENABLED (xw, event_type_button_up))
+ result =
+ (button_event (xw, (& (event -> xbutton)), event_type_button_up));
+ break;
+ case MotionNotify:
+ 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));
+ }
+ 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));
+ }
+ break;
+ case EnterNotify:
+ if (EVENT_ENABLED (xw, event_type_enter))
+ result = (make_event_object (xw, event_type_enter, 0));
+ break;
+ case LeaveNotify:
+ if (EVENT_ENABLED (xw, event_type_leave))
+ result = (make_event_object (xw, event_type_leave, 0));
+ break;
+ case FocusIn:
+ if (EVENT_ENABLED (xw, event_type_focus_in))
+ result = (make_event_object (xw, event_type_focus_in, 0));
+ break;
+ case FocusOut:
+ if (EVENT_ENABLED (xw, event_type_focus_out))
+ result = (make_event_object (xw, event_type_focus_out, 0));
break;
}
+ return (result);
+}
+\f
+/* The use of `XD_CACHED_EVENT' prevents an event from being lost due
+ to garbage collection. First `XD_CACHED_EVENT' is set to hold the
+ current event, then the allocations are performed. If one of them
+ fails, the primitive will exit, and when it reenters it will notice
+ the cached event and use it. It is important that this be the only
+ entry that reads events -- or else that all other event readers
+ cooperate with this strategy. */
- case ButtonPress:
- {
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = ((event -> xbutton) . x);
- int pointer_y = ((event -> xbutton) . y);
- return
- (MAKE_EVENT (EVENT_TYPE_BUTTON_DOWN,
- xw_index,
- cons (long_to_integer (button),
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_x),
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_y),
- EMPTY_LIST)))));
- }
- break;
-
- case ButtonRelease:
- {
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = ((event -> xbutton) . x);
- int pointer_y = ((event -> xbutton) . y);
- return
- (MAKE_EVENT (EVENT_TYPE_BUTTON_UP,
- xw_index,
- cons (long_to_integer (button),
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_x),
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_y),
- EMPTY_LIST)))));
- }
- break;
-
- case NoExpose:
- return (MAKE_EVENT (EVENT_TYPE_NO_EXPOSE, xw_index, SHARP_F));
- break;
-
- case EnterNotify:
- return (MAKE_EVENT (EVENT_TYPE_ENTER, xw_index, SHARP_F));
- break;
-
- case LeaveNotify:
- return (MAKE_EVENT (EVENT_TYPE_LEAVE, xw_index, SHARP_F));
- break;
-
- case FocusIn:
- return (MAKE_EVENT (EVENT_TYPE_FOCUS_IN, xw_index, SHARP_F));
- break;
-
- case FocusOut:
- return (MAKE_EVENT (EVENT_TYPE_FOCUS_OUT, xw_index, SHARP_F));
- break;
-
- case MotionNotify:
+static SCHEME_OBJECT
+DEFUN (xd_process_events, (xd, time_limit_p, time_limit),
+ struct xdisplay * xd AND
+ int time_limit_p AND
+ unsigned long time_limit)
+{
+ unsigned int events_queued = 0;
+ Display * display = (XD_DISPLAY (xd));
+ if (XD_CACHED_EVENT_P (xd))
+ goto restart;
+ while (1)
{
- int pointer_x = ((event -> xbutton) . x);
- int pointer_y = ((event -> xbutton) . y);
- return
- (MAKE_EVENT (EVENT_TYPE_MOTION,
- xw_index,
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_x),
- cons (LONG_TO_UNSIGNED_FIXNUM (pointer_y),
- EMPTY_LIST))));
+ extern unsigned long EXFUN (OS_real_time_clock, (void));
+ XEvent event;
+ if (time_limit_p)
+ {
+ if (events_queued == 0)
+ while (1)
+ {
+ events_queued = (XEventsQueued (display, QueuedAfterReading));
+ if (events_queued > 0)
+ break;
+ if ((OS_real_time_clock ()) >= time_limit)
+ return (SHARP_F);
+ }
+ events_queued -= 1;
+ }
+ XNextEvent (display, (&event));
+ if ((event . type) == KeymapNotify)
+ continue;
+ {
+ struct xwindow * xw = (x_window_to_xw (event . xany . window));
+ if (xw == 0)
+ continue;
+ xw_process_event (xw, (&event));
+ }
+ (XD_CACHED_EVENT (xd)) = event;
+ (XD_CACHED_EVENT_P (xd)) = 1;
+ restart:
+ {
+ SCHEME_OBJECT result = (x_event_to_object (&event));
+ (XD_CACHED_EVENT_P (xd)) = 0;
+ if (result != SHARP_F)
+ return (result);
+ }
}
- return (MAKE_EVENT (EVENT_TYPE_MOTION, xw_index, SHARP_F));
- break;
+}
- default:
- return (MAKE_EVENT (EVENT_TYPE_UNKNOWN, xw_index, SHARP_F));
- break;
- }
+static void
+DEFUN_VOID (initialize_once)
+{
+ allocation_table_initialize (&x_display_table);
+ allocation_table_initialize (&x_window_table);
+ XSetErrorHandler (x_error_handler);
+ XSetIOErrorHandler (x_io_error_handler);
+ add_reload_cleanup (x_close_all_displays);
+ initialization_done = 1;
}
\f
-DEFINE_PRIMITIVE ("X-PROCESS-EVENTS", Prim_x_process_events, 0, 0,
-"Process any pending X events. Does not wait.")
+DEFINE_PRIMITIVE ("X-DEBUG", Prim_x_debug, 1, 1, 0)
{
- PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (x_process_events ()));
+ PRIMITIVE_HEADER (1);
+ x_debug = (BOOLEAN_ARG (1));
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-/* X-WAIT-FOR-EVENT-ON-WINDOW should be supplemented to accept a
- time out argument */
+DEFINE_PRIMITIVE ("X-OPEN-DISPLAY", Prim_x_open_display, 1, 1, 0)
+{
+ PRIMITIVE_HEADER (1);
+ INITIALIZE_ONCE ();
+ {
+ struct xdisplay * xd = (x_malloc (sizeof (struct xdisplay)));
+ (XD_DISPLAY (xd)) =
+ (XOpenDisplay (((ARG_REF (1)) == SHARP_F) ? 0 : (STRING_ARG (1))));
+ if ((XD_DISPLAY (xd)) == 0)
+ {
+ free (xd);
+ PRIMITIVE_RETURN (SHARP_F);
+ }
+ (XD_ALLOCATION_INDEX (xd)) =
+ (allocate_table_index ((&x_display_table), xd));
+ (XD_CACHED_EVENT_P (xd)) = 0;
+ PRIMITIVE_RETURN (XD_TO_OBJECT (xd));
+ }
+}
-DEFINE_PRIMITIVE ("X-WAIT-FOR-EVENT-ON-WINDOW",
- Prim_x_wait_for_event_on_window, 1, 1,
-"Wait for an X event for the X-WINDOW-INDEX argument.")
+DEFINE_PRIMITIVE ("X-CLOSE-DISPLAY", Prim_x_close_display, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- xw_wait_for_window_event (WINDOW_ARG (1));
+ x_close_display (x_display_arg (1));
PRIMITIVE_RETURN (UNSPECIFIC);
}
-/* X-WAIT-FOR-EVENT should be supplemented to accept a time out argument */
-
-DEFINE_PRIMITIVE ("X-WAIT-FOR-EVENT", Prim_x_wait_for_event, 0, 0,
-"Wait for an X event. It is possible that this procedure will return\n\
-even though there there are no X events. The return value will tell\n\
-you if there were actually any events processed.")
+DEFINE_PRIMITIVE ("X-CLOSE-ALL-DISPLAYS", Prim_x_close_all_displays, 0, 0, 0)
{
PRIMITIVE_HEADER (0);
- PRIMITIVE_RETURN (BOOLEAN_TO_OBJECT (x_wait_for_event ()));
+ INITIALIZE_ONCE ();
+ x_close_all_displays ();
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-WINDOW-READ-EVENT-FLAGS!", Prim_x_window_read_event_flags, 1, 1, 0)
+DEFINE_PRIMITIVE ("X-CLOSE-WINDOW", Prim_x_close_window, 1, 1, 0)
{
- struct xwindow * xw;
- int old;
PRIMITIVE_HEADER (1);
-
- xw = (WINDOW_ARG (1));
- old = (XW_EVENT_FLAGS (xw));
- (XW_EVENT_FLAGS (xw)) = 0;
- /* Mask the result so that only three bits of information are
- returned. This primitive is only used for maintaining the old
- version of Edwin -- newer versions use a different interface that
- supplies more event types. */
- PRIMITIVE_RETURN (long_to_integer (old & 0x7));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ x_close_window (xw);
+ XFlush (display);
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-
-DEFINE_PRIMITIVE ("X-DEQUEUE-GLOBAL-EVENT", Prim_x_dequeue_global_event, 0, 0,
-"Returns an list representing a single event from the global X event queue.\n\
-The list is of the form (EVENT-TYPE X-WINDOW-INDEX . EXTRA) where EXTRA is\n\
-dependent on the EVENT-TYPE.")
+\f
+DEFINE_PRIMITIVE ("X-DISPLAY-PROCESS-EVENTS", Prim_x_display_process_events, 2, 2, 0)
{
- XEvent event;
- int any_events;
- PRIMITIVE_HEADER (0);
-
- any_events = x_dequeue_global_event (& event);
- if (!any_events) {
- PRIMITIVE_RETURN (SHARP_F);
- }
- PRIMITIVE_RETURN (x_event_to_scheme_event (& event));
-}
-
-DEFINE_PRIMITIVE ("X-RETURN-EVENT-QUEUE", Prim_x_return_event_queue, 0, 0,
- "Returns an list of all events (in order) from the global X event queue \n\
-and flushes the queue. Each event on the list is of the form \n\
-(EVENT-TYPE X-WINDOW-INDEX . EXTRA) where EXTRA is dependent on the \n\
-EVENT-TYPE.")
-{
- XEvent event;
- int any_events;
- SCHEME_OBJECT event_list;
- SCHEME_OBJECT event_list_tail;
- SCHEME_OBJECT new_event;
- PRIMITIVE_HEADER (0);
-
- any_events = x_dequeue_global_event (& event);
- if (!any_events) {
- return (SHARP_F);
- }
- event_list = cons (x_event_to_scheme_event (& event), EMPTY_LIST);
- event_list_tail = event_list;
- while (any_events = x_dequeue_global_event (& event)) {
- new_event = cons (x_event_to_scheme_event (& event), EMPTY_LIST);
- SET_PAIR_CDR (event_list_tail, new_event);
- event_list_tail = new_event;
+ PRIMITIVE_HEADER (2);
+ {
+ struct xdisplay * xd = (x_display_arg (1));
+ PRIMITIVE_RETURN
+ (((ARG_REF (2)) == SHARP_F)
+ ? (xd_process_events (xd, 0, 0))
+ : (xd_process_events (xd, 1, (arg_nonnegative_integer (2)))));
}
- PRIMITIVE_RETURN (event_list);
}
-
-\f
-static int initialization_done = 0;
static void
-DEFUN_VOID (x_close_all_displays)
+DEFUN (update_input_mask, (xw), struct xwindow * xw)
{
- Display ** items = ((Display **) (x_display_table . items));
- int length = (x_display_table . length);
- int i;
- for (i = 0; (i < length); i += 1)
- if ((items [i]) != ((Display *) 0))
- x_close_display (i);
+ long event_mask = (ExposureMask | StructureNotifyMask);
+ if (EVENT_ENABLED (xw, event_type_button_down))
+ event_mask |= ButtonPressMask;
+ if (EVENT_ENABLED (xw, event_type_button_up))
+ event_mask |= ButtonReleaseMask;
+ if (EVENT_ENABLED (xw, event_type_key_press))
+ event_mask |= KeyPressMask;
+ if (EVENT_ENABLED (xw, event_type_enter))
+ event_mask |= EnterWindowMask;
+ if (EVENT_ENABLED (xw, event_type_leave))
+ event_mask |= LeaveWindowMask;
+ if ((EVENT_ENABLED (xw, event_type_focus_in))
+ || (EVENT_ENABLED (xw, event_type_focus_out)))
+ event_mask |= FocusChangeMask;
+ if (EVENT_ENABLED (xw, event_type_motion))
+ event_mask |= PointerMotionMask;
+ XSelectInput ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), event_mask);
+}
+
+DEFINE_PRIMITIVE ("X-WINDOW-EVENT-MASK", Prim_x_window_event_mask, 1, 1, 0)
+{
+ PRIMITIVE_HEADER (1);
+ PRIMITIVE_RETURN (long_to_integer (XW_EVENT_MASK (x_window_arg (1))));
}
-DEFINE_PRIMITIVE ("X-OPEN-DISPLAY", Prim_x_open_display, 1, 1, 0)
+DEFINE_PRIMITIVE ("X-WINDOW-SET-EVENT-MASK", Prim_x_window_set_event_mask, 2, 2, 0)
{
- Display * display;
- int display_file_descriptor;
- PRIMITIVE_HEADER (1);
- if (!initialization_done)
- {
- add_reload_cleanup (x_close_all_displays);
- initialization_done = 1;
- }
- display =
- (XOpenDisplay (((ARG_REF (1)) == SHARP_F) ? 0 : (STRING_ARG (1))));
- if (display == 0)
- PRIMITIVE_RETURN (SHARP_F);
- /* This only needs to be done once for this process, but it doesn't
- hurt to run it every time we open the display. */
- XSetErrorHandler (x_error_handler);
- XSetIOErrorHandler (x_io_error_handler);
+ PRIMITIVE_HEADER (2);
{
- int display_file_descriptor = ConnectionNumber (display);
-
- if (! x_select_mask_size) {
- x_select_mask_size = 1;
- x_select_mask = (x_malloc (x_select_mask_size * sizeof (int)));
- }
-
- if (display_file_descriptor > x_max_file_descriptor) {
-
- int new_select_mask_size;
-
- x_max_file_descriptor = display_file_descriptor;
- new_select_mask_size = 1 + (x_max_file_descriptor / BITS_PER_INT);
- if (new_select_mask_size > x_select_mask_size) {
- x_select_mask = (x_realloc (x_select_mask,
- new_select_mask_size * sizeof (int)));
- x_select_mask_size = new_select_mask_size;
- }
- SET_X_SELECT_MASK (display_file_descriptor);
- }
+ struct xwindow * xw = (x_window_arg (1));
+ (XW_EVENT_MASK (xw)) = (EVENT_MASK_ARG (2));
+ update_input_mask (xw);
}
- PRIMITIVE_RETURN
- (LONG_TO_UNSIGNED_FIXNUM
- (x_allocate_table_index ((& x_display_table), ((char *) display))));
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-CLOSE-DISPLAY", Prim_x_close_display, 1, 1, 0)
+DEFINE_PRIMITIVE ("X-WINDOW-OR-EVENT-MASK", Prim_x_window_or_event_mask, 2, 2, 0)
{
- PRIMITIVE_HEADER (1);
- x_close_display (x_allocation_index_arg (1, (& x_display_table)));
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ (XW_EVENT_MASK (xw)) |= (EVENT_MASK_ARG (2));
+ update_input_mask (xw);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-CLOSE-ALL-DISPLAYS", Prim_x_close_all_displays, 0, 0, 0)
+DEFINE_PRIMITIVE ("X-WINDOW-ANDC-EVENT-MASK", Prim_x_window_andc_event_mask, 2, 2, 0)
{
- PRIMITIVE_HEADER (0);
- x_close_all_displays ();
+ PRIMITIVE_HEADER (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ (XW_EVENT_MASK (xw)) &=~ (EVENT_MASK_ARG (2));
+ update_input_mask (xw);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
-DEFINE_PRIMITIVE ("X-CLOSE-WINDOW", Prim_x_close_window, 1, 1, 0)
+\f
+DEFINE_PRIMITIVE ("X-WINDOW-DISPLAY", Prim_x_window_display, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- XFlush (x_close_window (x_allocation_index_arg (1, (& x_window_table))));
- PRIMITIVE_RETURN (UNSPECIFIC);
+ PRIMITIVE_RETURN (XD_TO_OBJECT (XW_XD (x_window_arg (1))));
}
-\f
+
DEFINE_PRIMITIVE ("X-WINDOW-X-SIZE", Prim_x_window_x_size, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_X_SIZE (WINDOW_ARG (1))));
+ PRIMITIVE_RETURN (long_to_integer (XW_X_SIZE (x_window_arg (1))));
}
DEFINE_PRIMITIVE ("X-WINDOW-Y-SIZE", Prim_x_window_y_size, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_Y_SIZE (WINDOW_ARG (1))));
+ PRIMITIVE_RETURN (long_to_integer (XW_Y_SIZE (x_window_arg (1))));
}
DEFINE_PRIMITIVE ("X-WINDOW-MAP", Prim_x_window_map, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- Display * display = (XW_DISPLAY (xw));
- (XW_VISIBLE_P (xw)) = 1;
- XMapWindow (display, (XW_WINDOW (xw)));
+ struct xwindow * xw = (x_window_arg (1));
+ XMapWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
{
PRIMITIVE_HEADER (1);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- Display * display = (XW_DISPLAY (xw));
- (XW_VISIBLE_P (xw)) = 0;
- XUnmapWindow (display, (XW_WINDOW (xw)));
+ struct xwindow * xw = (x_window_arg (1));
+ XUnmapWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("X-WINDOW-BEEP", Prim_x_window_beep, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- XBell ((XW_DISPLAY (WINDOW_ARG (1))), 100); /* 100% */
+ XBell ((XW_DISPLAY (x_window_arg (1))), 100); /* 100% */
PRIMITIVE_RETURN (UNSPECIFIC);
}
{
PRIMITIVE_HEADER (1);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
XClearArea ((XW_DISPLAY (xw)),
(XW_WINDOW (xw)),
- (XW_CLIP_X (xw)),
- (XW_CLIP_Y (xw)),
+ ((XW_CLIP_X (xw)) + (XW_INTERNAL_BORDER_WIDTH (xw))),
+ ((XW_CLIP_Y (xw)) + (XW_INTERNAL_BORDER_WIDTH (xw))),
(XW_CLIP_WIDTH (xw)),
(XW_CLIP_HEIGHT (xw)),
False);
PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-WINDOW-FLUSH", Prim_x_window_flush, 1, 1, 0)
+DEFINE_PRIMITIVE ("X-DISPLAY-FLUSH", Prim_x_display_flush, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- XFlush (XW_DISPLAY (WINDOW_ARG (1)));
+ XFlush (XD_DISPLAY (x_display_arg (1)));
PRIMITIVE_RETURN (UNSPECIFIC);
}
+DEFINE_PRIMITIVE ("X-DISPLAY-SYNC", Prim_x_display_sync, 2, 2, 0)
+{
+ PRIMITIVE_HEADER (2);
+ XSync ((XD_DISPLAY (x_display_arg (1))), (BOOLEAN_ARG (2)));
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
DEFINE_PRIMITIVE ("X-WINDOW-GET-DEFAULT", Prim_x_window_get_default, 3, 3, 0)
{
PRIMITIVE_HEADER (3);
{
char * result =
(XGetDefault
- ((XW_DISPLAY (WINDOW_ARG (1))), (STRING_ARG (2)), (STRING_ARG (3))));
+ ((XW_DISPLAY (x_window_arg (1))), (STRING_ARG (2)), (STRING_ARG (3))));
PRIMITIVE_RETURN
((result == 0) ? SHARP_F : (char_pointer_to_string (result)));
}
}
-\f
+
DEFINE_PRIMITIVE ("X-WINDOW-SET-FOREGROUND-COLOR", Prim_x_window_set_foreground_color, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- unsigned long foreground_pixel;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- foreground_pixel =
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- (STRING_ARG (2)),
- (XW_FOREGROUND_PIXEL (xw))));
- (XW_FOREGROUND_PIXEL (xw)) = foreground_pixel;
- XSetForeground (display, (XW_NORMAL_GC (xw)), foreground_pixel);
- XSetBackground (display, (XW_REVERSE_GC (xw)), foreground_pixel);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned long foreground_pixel = (arg_color (2, display));
+ (XW_FOREGROUND_PIXEL (xw)) = foreground_pixel;
+ XSetForeground (display, (XW_NORMAL_GC (xw)), foreground_pixel);
+ XSetBackground (display, (XW_REVERSE_GC (xw)), foreground_pixel);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("X-WINDOW-SET-BACKGROUND-COLOR", Prim_x_window_set_background_color, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- unsigned long background_pixel;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- background_pixel =
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- (STRING_ARG (2)),
- (XW_BACKGROUND_PIXEL (xw))));
- (XW_BACKGROUND_PIXEL (xw)) = background_pixel;
- XSetWindowBackground (display, (XW_WINDOW (xw)), background_pixel);
- XSetBackground (display, (XW_NORMAL_GC (xw)), background_pixel);
- XSetForeground (display, (XW_REVERSE_GC (xw)), background_pixel);
- XSetForeground (display, (XW_CURSOR_GC (xw)), background_pixel);
- x_set_mouse_colors
- (display, (XW_MOUSE_CURSOR (xw)), (XW_MOUSE_PIXEL (xw)), background_pixel);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned long background_pixel = (arg_color (2, display));
+ (XW_BACKGROUND_PIXEL (xw)) = background_pixel;
+ XSetWindowBackground (display, (XW_WINDOW (xw)), background_pixel);
+ XSetBackground (display, (XW_NORMAL_GC (xw)), background_pixel);
+ XSetForeground (display, (XW_REVERSE_GC (xw)), background_pixel);
+ XSetForeground (display, (XW_CURSOR_GC (xw)), background_pixel);
+ x_set_mouse_colors
+ (display,
+ (XW_MOUSE_CURSOR (xw)),
+ (XW_MOUSE_PIXEL (xw)),
+ background_pixel);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("X-WINDOW-SET-BORDER-COLOR", Prim_x_window_set_border_color, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- unsigned long border_pixel;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- border_pixel =
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- (STRING_ARG (2)),
- (XW_BORDER_PIXEL (xw))));
- (XW_BORDER_PIXEL (xw)) = border_pixel;
- XSetWindowBorder (display, (XW_WINDOW (xw)), border_pixel);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned long border_pixel = (arg_color (2, display));
+ (XW_BORDER_PIXEL (xw)) = border_pixel;
+ XSetWindowBorder (display, (XW_WINDOW (xw)), border_pixel);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-\f
+
DEFINE_PRIMITIVE ("X-WINDOW-SET-CURSOR-COLOR", Prim_x_window_set_cursor_color, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- unsigned long cursor_pixel;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- cursor_pixel =
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- (STRING_ARG (2)),
- (XW_CURSOR_PIXEL (xw))));
- (XW_CURSOR_PIXEL (xw)) = cursor_pixel;
- XSetBackground (display, (XW_CURSOR_GC (xw)), cursor_pixel);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned long cursor_pixel = (arg_color (2, display));
+ (XW_CURSOR_PIXEL (xw)) = cursor_pixel;
+ XSetBackground (display, (XW_CURSOR_GC (xw)), cursor_pixel);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
+\f
DEFINE_PRIMITIVE ("X-WINDOW-SET-MOUSE-COLOR", Prim_x_window_set_mouse_color, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- unsigned long mouse_pixel;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- mouse_pixel =
- (x_decode_color
- (display,
- (DefaultColormap (display, (DefaultScreen (display)))),
- (STRING_ARG (2)),
- (XW_MOUSE_PIXEL (xw))));
- (XW_MOUSE_PIXEL (xw)) = mouse_pixel;
- x_set_mouse_colors
- (display, (XW_MOUSE_CURSOR (xw)), mouse_pixel, (XW_BACKGROUND_PIXEL (xw)));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned long mouse_pixel = (arg_color (2, display));
+ (XW_MOUSE_PIXEL (xw)) = mouse_pixel;
+ x_set_mouse_colors
+ (display,
+ (XW_MOUSE_CURSOR (xw)),
+ mouse_pixel,
+ (XW_BACKGROUND_PIXEL (xw)));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("X-WINDOW-SET-MOUSE-SHAPE", Prim_x_window_set_mouse_shape, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- Window window;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- window = (XW_WINDOW (xw));
{
- Cursor old_cursor = (XW_MOUSE_CURSOR (xw));
- Cursor mouse_cursor =
- (XCreateFontCursor
- (display, (2 * (arg_index_integer (2, (XC_num_glyphs / 2))))));
- x_set_mouse_colors
- (display,
- mouse_cursor,
- (XW_MOUSE_PIXEL (xw)),
- (XW_BACKGROUND_PIXEL (xw)));
- (XW_MOUSE_CURSOR (xw)) = mouse_cursor;
- XDefineCursor (display, window, mouse_cursor);
- XFreeCursor (display, old_cursor);
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ Window window = (XW_WINDOW (xw));
+ {
+ Cursor old_cursor = (XW_MOUSE_CURSOR (xw));
+ Cursor mouse_cursor =
+ (XCreateFontCursor
+ (display, (2 * (arg_index_integer (2, (XC_num_glyphs / 2))))));
+ x_set_mouse_colors
+ (display,
+ mouse_cursor,
+ (XW_MOUSE_PIXEL (xw)),
+ (XW_BACKGROUND_PIXEL (xw)));
+ (XW_MOUSE_CURSOR (xw)) = mouse_cursor;
+ XDefineCursor (display, window, mouse_cursor);
+ XFreeCursor (display, old_cursor);
+ }
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
-\f
+
DEFINE_PRIMITIVE ("X-WINDOW-SET-FONT", Prim_x_window_set_font, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- XFontStruct * font;
- Font fid;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- font = (XLoadQueryFont (display, (STRING_ARG (2))));
- if (font == ((XFontStruct *) 0))
- PRIMITIVE_RETURN (SHARP_F);
- XFreeFont (display, (XW_FONT (xw)));
- (XW_FONT (xw)) = font;
- fid = (font -> fid);
- XSetFont (display, (XW_NORMAL_GC (xw)), fid);
- XSetFont (display, (XW_REVERSE_GC (xw)), fid);
- XSetFont (display, (XW_CURSOR_GC (xw)), fid);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ XFontStruct * font = (XLoadQueryFont (display, (STRING_ARG (2))));
+ if (font == 0)
+ PRIMITIVE_RETURN (SHARP_F);
+ XFreeFont (display, (XW_FONT (xw)));
+ (XW_FONT (xw)) = font;
+ {
+ Font fid = (font -> fid);
+ XSetFont (display, (XW_NORMAL_GC (xw)), fid);
+ XSetFont (display, (XW_REVERSE_GC (xw)), fid);
+ XSetFont (display, (XW_CURSOR_GC (xw)), fid);
+ }
+ }
PRIMITIVE_RETURN (SHARP_T);
}
DEFINE_PRIMITIVE ("X-WINDOW-SET-BORDER-WIDTH", Prim_x_window_set_border_width, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- int border_width;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- border_width = (arg_nonnegative_integer (2));
- (XW_BORDER_WIDTH (xw)) = border_width;
- XSetWindowBorderWidth (display, (XW_WINDOW (xw)), border_width);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned int border_width = (arg_nonnegative_integer (2));
+ (XW_BORDER_WIDTH (xw)) = border_width;
+ XSetWindowBorderWidth (display, (XW_WINDOW (xw)), border_width);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
+\f
DEFINE_PRIMITIVE ("X-WINDOW-SET-INTERNAL-BORDER-WIDTH", Prim_x_window_set_internal_border_width, 2, 2, 0)
{
- struct xwindow * xw;
- Display * display;
- int internal_border_width;
- int extra;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- internal_border_width = (arg_nonnegative_integer (2));
- (XW_INTERNAL_BORDER_WIDTH (xw)) = internal_border_width;
- extra = (2 * internal_border_width);
- XResizeWindow
- (display,
- (XW_WINDOW (xw)),
- ((XW_X_SIZE (xw)) + extra),
- ((XW_Y_SIZE (xw)) + extra));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ unsigned int internal_border_width = (arg_nonnegative_integer (2));
+ (XW_INTERNAL_BORDER_WIDTH (xw)) = internal_border_width;
+ XResizeWindow
+ (display,
+ (XW_WINDOW (xw)),
+ ((XW_X_SIZE (xw)) + (2 * internal_border_width)),
+ ((XW_Y_SIZE (xw)) + (2 * internal_border_width)));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-\f
+
DEFINE_PRIMITIVE ("X-WINDOW-SET-SIZE", Prim_x_window_set_size, 3, 3, 0)
{
- struct xwindow * xw;
- int extra;
PRIMITIVE_HEADER (3);
-
- xw = (WINDOW_ARG (1));
- extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
- XResizeWindow
- ((XW_DISPLAY (xw)),
- (XW_WINDOW (xw)),
- ((arg_nonnegative_integer (2)) + extra),
- ((arg_nonnegative_integer (3)) + extra));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
+ XResizeWindow
+ ((XW_DISPLAY (xw)),
+ (XW_WINDOW (xw)),
+ ((arg_nonnegative_integer (2)) + extra),
+ ((arg_nonnegative_integer (3)) + extra));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
DEFINE_PRIMITIVE ("X-WINDOW-SET-POSITION", Prim_x_window_set_position, 3, 3, 0)
{
- struct xwindow * xw;
- Display * display;
- int screen_number;
PRIMITIVE_HEADER (3);
-
- xw = (WINDOW_ARG (1));
- display = (XW_DISPLAY (xw));
- screen_number = (DefaultScreen (display));
- XMoveWindow
- ((XW_DISPLAY (xw)),
- (XW_WINDOW (xw)),
- (arg_integer (2)),
- (arg_integer (3)));
- PRIMITIVE_RETURN (UNSPECIFIC);
-}
-
-DEFINE_PRIMITIVE ("X-WINDOW-PIXEL-COORD->CHAR-COORD",
- Prim_window_pixel_coord_to_char_coord,
- 2,
- 2,
-"Takes an X window and a pair (cons) of x and y pixel coordinates \n\
-and returns a pair of x and y character coordinates appropriate \n\
-for the current font associated with that window.")
-{
- struct xwindow * xw;
- SCHEME_OBJECT coord_list;
- SCHEME_OBJECT x_coord;
- SCHEME_OBJECT y_coord;
- PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- coord_list = (PAIR_ARG (2));
- x_coord = (PAIR_CAR (coord_list));
- y_coord = (PAIR_CDR (coord_list));
- if (!((INTEGER_P (x_coord)) && (INTEGER_P (y_coord)))) {
- error_wrong_type_arg (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Display * display = (XW_DISPLAY (xw));
+ int screen_number = (DefaultScreen (display));
+ XMoveWindow
+ ((XW_DISPLAY (xw)),
+ (XW_WINDOW (xw)),
+ (arg_integer (2)),
+ (arg_integer (3)));
}
- PRIMITIVE_RETURN
- (cons (long_to_integer (XTERM_X_CHARACTER (xw, integer_to_long (x_coord))),
- long_to_integer (XTERM_Y_CHARACTER (xw, integer_to_long (y_coord)))));
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-WINDOW-CHAR-COORD->PIXEL-COORD",
- Prim_window_char_coord_to_pixel_coord,
- 2,
- 2,
-"Takes an X window and a pair (cons) of x and y character coordinates \n\
-and returns a pair of x and y pixel coordinates appropriate \n\
-for the current font associated with that window.")
+DEFINE_PRIMITIVE ("X-WINDOW-SET-NAME", Prim_x_window_set_name, 2, 2,
+ "Set the name of WINDOW to STRING.")
{
- struct xwindow * xw;
- SCHEME_OBJECT coord_list;
- SCHEME_OBJECT x_coord;
- SCHEME_OBJECT y_coord;
PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- coord_list = (PAIR_ARG (2));
- x_coord = (PAIR_CAR (coord_list));
- y_coord = (PAIR_CDR (coord_list));
- if (!((INTEGER_P (x_coord)) && (INTEGER_P (y_coord)))) {
- error_wrong_type_arg (2);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ XStoreName ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (STRING_ARG (2)));
}
- PRIMITIVE_RETURN
- (cons (long_to_integer (XTERM_X_PIXEL (xw, integer_to_long (x_coord))),
- long_to_integer (XTERM_Y_PIXEL (xw, integer_to_long (y_coord)))));
-}
-
-DEFINE_PRIMITIVE ("X-SET-WINDOW-NAME", Prim_x_set_window_name, 2, 2,
-"Set the window name.")
-{
- struct xwindow * xw;
-
- PRIMITIVE_HEADER (2);
- xw = WINDOW_ARG (1);
- XStoreName (XW_DISPLAY (xw), XW_WINDOW (xw), STRING_ARG (2));
PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("X-SET-ICON-NAME", Prim_x_set_icon_name, 2, 2,
-"Set the window icon name.")
+DEFINE_PRIMITIVE ("X-WINDOW-SET-ICON-NAME", Prim_x_window_set_icon_name, 2, 2,
+ "Set the icon name of WINDOW to STRING.")
{
- struct xwindow * xw;
-
PRIMITIVE_HEADER (2);
- xw = WINDOW_ARG (1);
- XSetIconName (XW_DISPLAY (xw), XW_WINDOW (xw), STRING_ARG (2));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ XSetIconName ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (STRING_ARG (2)));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.6 1990/07/24 22:17:12 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.7 1990/10/02 22:52:35 cph Rel $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
#include "scheme.h"
#include "prims.h"
#include "x11.h"
-
+\f
#define RESOURCE_NAME "scheme-graphics"
#define DEFAULT_GEOMETRY "512x384+0+0"
-\f
+
struct gw_extra
{
float x_left;
#define ROUND_FLOAT(flonum) \
((int) (((flonum) >= 0.0) ? ((flonum) + 0.5) : ((flonum) - 0.5)))
-static int
-arg_x_coordinate (arg, xw)
- int arg;
- struct xwindow * xw;
+static unsigned int
+DEFUN (arg_x_coordinate, (arg, xw),
+ unsigned int arg AND
+ struct xwindow * xw)
{
float virtual_device_x = (arg_real_number (arg));
float device_x = ((XW_X_SLOPE (xw)) * (virtual_device_x - (XW_X_LEFT (xw))));
return (ROUND_FLOAT (device_x));
}
-static int
-arg_y_coordinate (arg, xw)
- int arg;
- struct xwindow * xw;
+static unsigned int
+DEFUN (arg_y_coordinate, (arg, xw),
+ unsigned int arg AND
+ struct xwindow * xw)
{
float virtual_device_y = (arg_real_number (arg));
float device_y =
((XW_Y_SLOPE (xw)) * (virtual_device_y - (XW_Y_BOTTOM (xw))));
return (((XW_Y_SIZE (xw)) - 1) + (ROUND_FLOAT (device_y)));
}
+
+static SCHEME_OBJECT
+DEFUN (x_coordinate_map, (xw, x), struct xwindow * xw AND unsigned int x)
+{
+ return
+ (FLOAT_TO_FLONUM ((((float) x) / (XW_X_SLOPE (xw))) + (XW_X_LEFT (xw))));
+}
+
+static SCHEME_OBJECT
+DEFUN (y_coordinate_map, (xw, y), struct xwindow * xw AND unsigned int y)
+{
+ return
+ (FLOAT_TO_FLONUM
+ ((((float) (y + ((XW_Y_SIZE (xw)) - 1))) / (XW_Y_SLOPE (xw)))
+ + (XW_Y_BOTTOM (xw))));
+}
\f
static void
-set_clip_rectangle (xw, x_left, y_bottom, x_right, y_top)
- struct xwindow * xw;
- int x_left;
- int y_bottom;
- int x_right;
- int y_top;
+DEFUN (set_clip_rectangle, (xw, x_left, y_bottom, x_right, y_top),
+ struct xwindow * xw AND
+ unsigned int x_left AND
+ unsigned int y_bottom AND
+ unsigned int x_right AND
+ unsigned int y_top)
{
XRectangle rectangles [1];
Display * display = (XW_DISPLAY (xw));
- int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+ unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
if (x_left > x_right)
{
- int x = x_left;
+ unsigned int x = x_left;
x_left = x_right;
x_right = x;
}
if (y_top > y_bottom)
{
- int y = y_top;
+ unsigned int y = y_top;
y_top = y_bottom;
y_bottom = y;
}
{
- int width = ((x_right + 1) - x_left);
- int height = ((y_bottom + 1) - y_top);
+ unsigned int width = ((x_right + 1) - x_left);
+ unsigned int height = ((y_bottom + 1) - y_top);
(XW_CLIP_X (xw)) = x_left;
(XW_CLIP_Y (xw)) = y_top;
(XW_CLIP_WIDTH (xw)) = width;
(XW_CLIP_HEIGHT (xw)) = height;
- ((rectangles [0]) . x) = x_left;
- ((rectangles [0]) . y) = y_top;
- ((rectangles [0]) . width) = width;
- ((rectangles [0]) . height) = height;
+ ((rectangles[0]) . x) = x_left;
+ ((rectangles[0]) . y) = y_top;
+ ((rectangles[0]) . width) = width;
+ ((rectangles[0]) . height) = height;
}
XSetClipRectangles
(display,
internal_border_width,
internal_border_width,
rectangles, 1, Unsorted);
- return;
}
static void
-reset_clip_rectangle (xw)
- struct xwindow * xw;
+DEFUN (reset_clip_rectangle, (xw), struct xwindow * xw)
{
set_clip_rectangle
(xw, 0, ((XW_Y_SIZE (xw)) - 1), ((XW_X_SIZE (xw)) - 1), 0);
- return;
}
static void
-reset_virtual_device_coordinates (xw)
- struct xwindow * xw;
+DEFUN (reset_virtual_device_coordinates, (xw), struct xwindow * xw)
{
/* Note that the expression ((XW_c_SIZE (xw)) - 1) guarantees that
both limits of the device coordinates will be inside the window. */
(((float) ((XW_Y_SIZE (xw)) - 1)) /
((XW_Y_BOTTOM (xw)) - (XW_Y_TOP (xw))));
reset_clip_rectangle (xw);
- return;
-}
-\f
-static XComposeStatus compose_status;
-
-static void
-process_event (xw, event)
- struct xwindow * xw;
- XEvent * event;
-{
- switch (event -> type)
- {
- case ConfigureNotify:
- if (x_debug) fprintf (stderr, "\nX event: ConfigureNotify\n");
- {
- int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
- int x_size = (((event -> xconfigure) . width) - extra);
- int y_size = (((event -> xconfigure) . height) - extra);
- if ((x_size != (XW_X_SIZE (xw))) || (y_size != (XW_Y_SIZE (xw))))
- {
- (XW_X_SIZE (xw)) = x_size;
- (XW_Y_SIZE (xw)) = y_size;
- reset_virtual_device_coordinates (xw);
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_RESIZED;
- XClearWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
- }
- }
- break;
-
- case MapNotify:
- if (x_debug) fprintf (stderr, "\nX event: MapNotify\n");
- (XW_VISIBLE_P (xw)) = 1;
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_MAP;
- break;
-
- case UnmapNotify:
- if (x_debug) fprintf (stderr, "\nX event: UnmapNotify\n");
- (XW_VISIBLE_P (xw)) = 0;
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_UNMAP;
- break;
-
- case ButtonPress:
- {
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = ((event -> xbutton) . x);
- int pointer_y = ((event -> xbutton) . y);
- if (button == (-1)) break;
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_BUTTON_DOWN;
- if (x_debug)
- fprintf (stderr, "\nX event: ButtonPress: Button=%d, X=%d, Y=%d\n",
- button, pointer_x, pointer_y);
- }
- break;
-
- case ButtonRelease:
- {
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = ((event -> xbutton) . x);
- int pointer_y = ((event -> xbutton) . y);
- if (button == (-1)) break;
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_BUTTON_UP;
- if (x_debug)
- fprintf (stderr, "\nX event: ButtonRelease: Button=%d, X=%d, Y=%d\n",
- button, pointer_x, pointer_y);
- }
- break;
-
- case KeyPress:
- {
- int nbytes;
- char copy_buffer[10];
- KeySym keysym;
-
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_KEY_PRESS;
- nbytes =
- (XLookupString ((& (event -> xkey)),
- (& (copy_buffer [0])),
- (sizeof (copy_buffer)),
- (& keysym),
- (& compose_status)));
- if (x_debug)
- {
- fprintf (stderr, "\nX event: KeyPress, key=%s\n", copy_buffer);
- }
- }
- break;
-
- case Expose:
- if (x_debug) fprintf (stderr, "\nX event: Expose\n");
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_EXPOSE;
- break;
-
- case GraphicsExpose:
- if (x_debug) fprintf (stderr, "\nX event: GraphicsExpose\n");
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_GRAPHICS_EXPOSE;
- break;
-
- case EnterNotify:
- if (x_debug) fprintf (stderr, "\nX event: EnterNotify\n");
- if (xw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_ENTER;
- }
- break;
-
- case LeaveNotify:
- if (x_debug) fprintf (stderr, "\nX event: LeaveNotify\n");
- if (xw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_LEAVE;
- }
- break;
-
- case FocusIn:
- if (x_debug) fprintf (stderr, "\nX event: FocusIn\n");
- if (xw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_FOCUS_IN;
- }
- break;
-
- case FocusOut:
- if (x_debug) fprintf (stderr, "\nX event: FocusOut\n");
- if (xw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_FOCUS_OUT;
- }
- break;
-
- case MotionNotify:
- if (x_debug) fprintf (stderr, "\nX event: MotionNotify\n");
- if (xw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (xw)) |= EVENT_FLAG_MOTION;
- }
- break;
-
- default:
- if (x_debug) fprintf (stderr, "\nX event: %d", (event -> type));
- break;
- }
- return;
-}
-
-static void
-process_events (xw)
- struct xwindow * xw;
-{
- (void) x_process_events();
}
\f
DEFINE_PRIMITIVE ("X-GRAPHICS-SET-VDC-EXTENT", Prim_x_graphics_set_vdc_extent, 5, 5,
{
PRIMITIVE_HEADER (5);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
float x_left = (arg_real_number (2));
float y_bottom = (arg_real_number (3));
float x_right = (arg_real_number (4));
float y_top = (arg_real_number (5));
- process_events (xw);
(XW_X_LEFT (xw)) = x_left;
(XW_Y_BOTTOM (xw)) = y_bottom;
(XW_X_RIGHT (xw)) = x_right;
DEFINE_PRIMITIVE ("X-GRAPHICS-VDC-EXTENT", Prim_x_graphics_vdc_extent, 1, 1, 0)
{
- struct xwindow * xw;
- SCHEME_OBJECT result;
PRIMITIVE_HEADER (5);
- xw = (WINDOW_ARG (1));
- process_events (xw);
- result = (allocate_marked_vector (TC_VECTOR, 4, true));
- VECTOR_SET (result, 0, (double_to_flonum ((double) (XW_X_LEFT (xw)))));
- VECTOR_SET (result, 1, (double_to_flonum ((double) (XW_Y_BOTTOM (xw)))));
- VECTOR_SET (result, 2, (double_to_flonum ((double) (XW_X_RIGHT (xw)))));
- VECTOR_SET (result, 3, (double_to_flonum ((double) (XW_Y_TOP (xw)))));
- PRIMITIVE_RETURN (result);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 4, true));
+ VECTOR_SET (result, 0, (double_to_flonum ((double) (XW_X_LEFT (xw)))));
+ VECTOR_SET (result, 1, (double_to_flonum ((double) (XW_Y_BOTTOM (xw)))));
+ VECTOR_SET (result, 2, (double_to_flonum ((double) (XW_X_RIGHT (xw)))));
+ VECTOR_SET (result, 3, (double_to_flonum ((double) (XW_Y_TOP (xw)))));
+ PRIMITIVE_RETURN (result);
+ }
}
DEFINE_PRIMITIVE ("X-GRAPHICS-RESET-CLIP-RECTANGLE", Prim_x_graphics_reset_clip_rectangle, 1, 1, 0)
{
- struct xwindow * xw;
PRIMITIVE_HEADER (1);
- xw = (WINDOW_ARG (1));
- process_events (xw);
- reset_clip_rectangle (xw);
+ reset_clip_rectangle (x_window_arg (1));
PRIMITIVE_RETURN (UNSPECIFIC);
}
"(X-GRAPHICS-SET-CLIP-RECTANGLE WINDOW X-LEFT Y-BOTTOM X-RIGHT Y-TOP)\n\
Set the clip rectangle to the given coordinates.")
{
- struct xwindow * xw;
- int x_left;
- int y_bottom;
- int x_right;
- int y_top;
PRIMITIVE_HEADER (5);
- xw = (WINDOW_ARG (1));
- process_events (xw);
- x_left = (arg_x_coordinate (2, xw));
- y_bottom = (arg_y_coordinate (3, xw));
- x_right = (arg_x_coordinate (4, xw));
- y_top = (arg_y_coordinate (5, xw));
- set_clip_rectangle (xw, x_left, y_bottom, x_right, y_top);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ set_clip_rectangle
+ (xw,
+ (arg_x_coordinate (2, xw)),
+ (arg_y_coordinate (3, xw)),
+ (arg_x_coordinate (4, xw)),
+ (arg_y_coordinate (5, xw)));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
static void
-wm_set_size_hint (xw, flags, x, y)
- struct xwindow * xw;
- long flags;
- int x, y;
+DEFUN (process_event, (xw, event),
+ struct xwindow * xw AND
+ XEvent * event)
{
- int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
+ switch (event -> type)
+ {
+ case ConfigureNotify:
+ {
+ unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
+ unsigned int x_size = (((event -> xconfigure) . width) - extra);
+ unsigned int y_size = (((event -> xconfigure) . height) - extra);
+ if ((x_size != (XW_X_SIZE (xw))) || (y_size != (XW_Y_SIZE (xw))))
+ {
+ (XW_X_SIZE (xw)) = x_size;
+ (XW_Y_SIZE (xw)) = y_size;
+ reset_virtual_device_coordinates (xw);
+ XClearWindow ((XW_DISPLAY (xw)), (XW_WINDOW (xw)));
+ }
+ }
+ break;
+ }
+}
+
+static void
+DEFUN (wm_set_size_hint, (xw, geometry_mask, x, y),
+ struct xwindow * xw AND
+ int geometry_mask AND
+ int x AND
+ int y)
+{
+ unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
XSizeHints size_hints;
- (size_hints . flags) = (PResizeInc | PMinSize | flags);
+ (size_hints . flags) =
+ (PResizeInc
+ | PMinSize
+ | (((geometry_mask & XValue) && (geometry_mask & YValue))
+ ? USPosition : PPosition)
+ | (((geometry_mask & WidthValue) && (geometry_mask & HeightValue))
+ ? USSize : PSize));
(size_hints . x) = x;
(size_hints . y) = y;
(size_hints . width) = ((XW_X_SIZE (xw)) + extra);
(size_hints . height_inc) = 1;
(size_hints . min_width) = extra;
(size_hints . min_height) = extra;
- XSetNormalHints ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (& size_hints));
- return;
+ XSetNormalHints ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&size_hints));
}
-#define MAKE_GC(gc, fore, back) \
-{ \
- XGCValues gcv; \
- (gcv . font) = fid; \
- (gcv . foreground) = (fore); \
- (gcv . background) = (back); \
- (gc) = \
- (XCreateGC (display, \
- window, \
- (GCFont | GCForeground | GCBackground), \
- (& gcv))); \
+#define MAKE_GC(gc, fore, back) \ \
+{ \ \
+ XGCValues gcv; \ \
+ (gcv . font) = fid; \ \
+ (gcv . foreground) = (fore); \ \
+ (gcv . background) = (back); \ \
+ (gc) = \ \
+ (XCreateGC (display, \ \
+ window, \ \
+ (GCFont | GCForeground | GCBackground), \ \
+ (& gcv))); \ \
}
\f
DEFINE_PRIMITIVE ("X-GRAPHICS-OPEN-WINDOW", Prim_x_graphics_open_window, 3, 3,
If GEOMETRY is false map window interactively.\n\
If third argument SUPPRESS-MAP? is true, do not map the window immediately.")
{
- Display * display;
- int screen_number;
- char * name;
- struct drawing_attributes attributes;
- int border_width;
- int internal_border_width;
- int extra;
- int x_pos;
- int y_pos;
- int x_size;
- int y_size;
- Window window;
- long flags;
- struct xwindow * xw;
PRIMITIVE_HEADER (3);
- display = (DISPLAY_ARG (1));
- screen_number = (DefaultScreen (display));
- name = "scheme-graphics";
- x_default_attributes (display, RESOURCE_NAME, (& attributes));
- border_width = (attributes . border_width);
- internal_border_width = (attributes . internal_border_width);
- extra = (2 * internal_border_width);
- x_pos = (-1);
- y_pos = (-1);
- x_size = 512;
- y_size = 384;
- {
- char * geometry =
- (((ARG_REF (2)) == SHARP_F)
- ? (x_get_default
- (display, RESOURCE_NAME, "geometry", "Geometry", ((char *) 0)))
- : (STRING_ARG (2)));
- int result =
- (XGeometry (display, screen_number, geometry,
- DEFAULT_GEOMETRY, border_width,
- 1, 1, extra, extra,
- (& x_pos), (& y_pos), (& x_size), (& y_size)));
- flags = 0;
- flags |=
- (((result & XValue) && (result & YValue)) ? USPosition : PPosition);
- flags |=
- (((result & WidthValue) && (result & HeightValue)) ? USSize : PSize);
- }
- /* Open the window with the given arguments. */
{
+ struct xdisplay * xd = (x_display_arg (1));
+ Display * display = (XD_DISPLAY (xd));
+ struct drawing_attributes attributes;
+ struct xwindow_methods methods;
XSetWindowAttributes wattributes;
+ x_default_attributes (display, RESOURCE_NAME, (&attributes));
(wattributes . background_pixel) = (attributes . background_pixel);
(wattributes . border_pixel) = (attributes . border_pixel);
(wattributes . backing_store) = Always;
- window =
- (XCreateWindow
- (display,
- (RootWindow (display, screen_number)),
- x_pos, y_pos, (x_size + extra), (y_size + extra), border_width,
- CopyFromParent, CopyFromParent, CopyFromParent,
- (CWBackPixel | CWBorderPixel | CWBackingStore),
- (& wattributes)));
- }
- if (window == ((Window) 0))
- error_external_return ();
- xw =
- (x_make_window
- (display,
- window,
- x_size,
- y_size,
- (& attributes),
- (sizeof (struct gw_extra)),
- ((void (*) ()) 0),
- process_event));
- (XW_X_LEFT (xw)) = ((float) (-1));
- (XW_X_RIGHT (xw)) = ((float) 1);
- (XW_Y_BOTTOM (xw)) = ((float) (-1));
- (XW_Y_TOP (xw)) = ((float) 1);
- reset_virtual_device_coordinates (xw);
- (XW_X_CURSOR (xw)) = 0;
- (XW_Y_CURSOR (xw)) = 0;
- XSelectInput (display, window,
- KeyPressMask | ExposureMask |
- ButtonPressMask | ButtonReleaseMask |
- StructureNotifyMask | FocusChangeMask |
- PointerMotionHintMask | ButtonMotionMask |
- LeaveWindowMask | EnterWindowMask);
- wm_set_size_hint (xw, flags, x_pos, y_pos);
- XStoreName (display, window, name);
- XSetIconName (display, window, name);
- if ((ARG_REF (3)) == SHARP_F)
+ (methods . deallocator) = 0;
+ (methods . event_processor) = process_event;
+ (methods . x_coordinate_map) = x_coordinate_map;
+ (methods . y_coordinate_map) = y_coordinate_map;
{
- (XW_VISIBLE_P (xw)) = 1;
- XMapWindow (display, window);
- XFlush (display);
+ unsigned int extra = (2 * (attributes . internal_border_width));
+ int x_pos = (-1);
+ int y_pos = (-1);
+ int x_size = 512;
+ int y_size = 384;
+ int geometry_mask =
+ (XGeometry (display, (DefaultScreen (display)),
+ (((ARG_REF (2)) == SHARP_F)
+ ? (x_get_default
+ (display, RESOURCE_NAME, "geometry", "Geometry", 0))
+ : (STRING_ARG (2))),
+ DEFAULT_GEOMETRY, (attributes . border_width),
+ 1, 1, extra, extra,
+ (&x_pos), (&y_pos), (&x_size), (&y_size)));
+ Window window =
+ (XCreateWindow
+ (display,
+ (RootWindow (display, (DefaultScreen (display)))),
+ x_pos, y_pos, (x_size + extra), (y_size + extra),
+ (attributes . border_width),
+ CopyFromParent, CopyFromParent, CopyFromParent,
+ (CWBackPixel | CWBorderPixel | CWBackingStore),
+ (&wattributes)));
+ if (window == 0)
+ error_external_return ();
+ {
+ struct xwindow * xw =
+ (x_make_window
+ (xd, window, x_size, y_size, (&attributes), (&methods),
+ (sizeof (struct gw_extra))));
+ (XW_X_LEFT (xw)) = ((float) (-1));
+ (XW_X_RIGHT (xw)) = ((float) 1);
+ (XW_Y_BOTTOM (xw)) = ((float) (-1));
+ (XW_Y_TOP (xw)) = ((float) 1);
+ reset_virtual_device_coordinates (xw);
+ (XW_X_CURSOR (xw)) = 0;
+ (XW_Y_CURSOR (xw)) = 0;
+ wm_set_size_hint (xw, geometry_mask, x_pos, y_pos);
+ XStoreName (display, window, "scheme-graphics");
+ XSetIconName (display, window, "scheme-graphics");
+ if ((ARG_REF (3)) == SHARP_F)
+ {
+ XMapWindow (display, window);
+ XFlush (display);
+ }
+ PRIMITIVE_RETURN (XW_TO_OBJECT (xw));
+ }
}
- PRIMITIVE_RETURN (x_window_to_object (xw));
+ }
}
\f
DEFINE_PRIMITIVE ("X-GRAPHICS-DRAW-LINE", Prim_x_graphics_draw_line, 5, 5,
{
PRIMITIVE_HEADER (5);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- int new_x_cursor = (arg_x_coordinate (4, xw));
- int new_y_cursor = (arg_y_coordinate (5, xw));
- int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int new_x_cursor = (arg_x_coordinate (4, xw));
+ unsigned int new_y_cursor = (arg_y_coordinate (5, xw));
+ unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
XDrawLine
((XW_DISPLAY (xw)),
(XW_WINDOW (xw)),
"(X-GRAPHICS-MOVE-CURSOR WINDOW X Y)\n\
Move the graphics cursor to the given coordinates.")
{
- struct xwindow * xw;
PRIMITIVE_HEADER (3);
- xw = (WINDOW_ARG (1));
- (XW_X_CURSOR (xw)) = (arg_x_coordinate (2, xw));
- (XW_Y_CURSOR (xw)) = (arg_y_coordinate (3, xw));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ (XW_X_CURSOR (xw)) = (arg_x_coordinate (2, xw));
+ (XW_Y_CURSOR (xw)) = (arg_y_coordinate (3, xw));
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
{
PRIMITIVE_HEADER (3);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- int new_x_cursor = (arg_x_coordinate (2, xw));
- int new_y_cursor = (arg_y_coordinate (3, xw));
- int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int new_x_cursor = (arg_x_coordinate (2, xw));
+ unsigned int new_y_cursor = (arg_y_coordinate (3, xw));
+ unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
XDrawLine
((XW_DISPLAY (xw)),
(XW_WINDOW (xw)),
{
PRIMITIVE_HEADER (3);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
XDrawPoint
((XW_DISPLAY (xw)),
(XW_WINDOW (xw)),
{
PRIMITIVE_HEADER (4);
{
- struct xwindow * xw = (WINDOW_ARG (1));
- int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int internal_border_width = (XW_INTERNAL_BORDER_WIDTH (xw));
char * s = (STRING_ARG (4));
XDrawString
((XW_DISPLAY (xw)),
{
PRIMITIVE_HEADER (2);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
Display * display = (XW_DISPLAY (xw));
- int function = (arg_index_integer (2, 16));
+ unsigned int function = (arg_index_integer (2, 16));
XSetFunction (display, (XW_NORMAL_GC (xw)), function);
XSetFunction (display, (XW_REVERSE_GC (xw)), function);
}
{
PRIMITIVE_HEADER (2);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
Display * display = (XW_DISPLAY (xw));
- int fill_style = (arg_index_integer (2, 4));
+ unsigned int fill_style = (arg_index_integer (2, 4));
XSetFillStyle (display, (XW_NORMAL_GC (xw)), fill_style);
XSetFillStyle (display, (XW_REVERSE_GC (xw)), fill_style);
}
{
PRIMITIVE_HEADER (2);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
Display * display = (XW_DISPLAY (xw));
- int style = (arg_index_integer (2, 3));
+ unsigned int style = (arg_index_integer (2, 3));
XSetLineAttributes
(display, (XW_NORMAL_GC (xw)), 0, style, CapButt, JoinMiter);
XSetLineAttributes
{
PRIMITIVE_HEADER (3);
{
- struct xwindow * xw = (WINDOW_ARG (1));
+ struct xwindow * xw = (x_window_arg (1));
Display * display = (XW_DISPLAY (xw));
char * dash_list = (STRING_ARG (3));
- int dash_list_length = (STRING_LENGTH (ARG_REF (3)));
- int dash_offset = (arg_index_integer (2, dash_list_length));
+ unsigned int dash_list_length = (STRING_LENGTH (ARG_REF (3)));
+ unsigned int dash_offset = (arg_index_integer (2, dash_list_length));
XSetDashes
(display, (XW_NORMAL_GC (xw)), dash_offset, dash_list, dash_list_length);
XSetDashes
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
-DEFINE_PRIMITIVE ("X-GRAPHICS-PROCESS-EVENTS", Prim_x_graphics_process_events, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- process_events (WINDOW_ARG (1));
- PRIMITIVE_RETURN (UNSPECIFIC);
-}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11term.c,v 1.9 1990/07/16 21:01:11 markf Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11term.c,v 1.10 1990/10/02 22:52:40 cph Exp $
Copyright (c) 1989, 1990 Massachusetts Institute of Technology
#include "scheme.h"
#include "prims.h"
#include "x11.h"
-#include "x11term.h"
+\f
+struct xterm_extra
+{
+ /* Dimensions of the window, in characters. Valid character
+ coordinates are nonnegative integers strictly less than these
+ limits. */
+ unsigned int x_size;
+ unsigned int y_size;
+
+ /* Position of the cursor, in character coordinates. */
+ unsigned int cursor_x;
+ unsigned int cursor_y;
+
+ /* Character map of the window's contents. See `XTERM_CHAR_LOC' for
+ the address arithmetic. */
+ char * character_map;
+
+ /* Bit map of the window's highlighting. */
+ char * highlight_map;
+
+ /* Nonzero iff the cursor is drawn on the window. */
+ char cursor_visible_p;
+
+ /* Nonzero iff the cursor should be drawn on the window. */
+ char cursor_enabled_p;
+};
+
+#define XW_EXTRA(xw) ((struct xterm_extra *) ((xw) -> extra))
+
+#define XW_X_CSIZE(xw) ((XW_EXTRA (xw)) -> x_size)
+#define XW_Y_CSIZE(xw) ((XW_EXTRA (xw)) -> y_size)
+#define XW_CURSOR_X(xw) ((XW_EXTRA (xw)) -> cursor_x)
+#define XW_CURSOR_Y(xw) ((XW_EXTRA (xw)) -> cursor_y)
+#define XW_CHARACTER_MAP(xw) ((XW_EXTRA (xw)) -> character_map)
+#define XW_HIGHLIGHT_MAP(xw) ((XW_EXTRA (xw)) -> highlight_map)
+#define XW_CURSOR_VISIBLE_P(xw) ((XW_EXTRA (xw)) -> cursor_visible_p)
+#define XW_CURSOR_ENABLED_P(xw) ((XW_EXTRA (xw)) -> cursor_enabled_p)
+
+#define XTERM_CHAR_INDEX(xw, x, y) (((y) * (XW_X_CSIZE (xw))) + (x))
+#define XTERM_CHAR_LOC(xw, index) ((XW_CHARACTER_MAP (xw)) + (index))
+#define XTERM_CHAR(xw, index) (* (XTERM_CHAR_LOC (xw, index)))
+#define XTERM_HL_LOC(xw, index) ((XW_HIGHLIGHT_MAP (xw)) + (index))
+#define XTERM_HL(xw, index) (* (XTERM_HL_LOC (xw, index)))
+
+#define XTERM_HL_GC(xw, hl) (hl ? (XW_REVERSE_GC (xw)) : (XW_NORMAL_GC (xw)))
+
+#define HL_ARG(arg) arg_index_integer (arg, 2)
#define RESOURCE_NAME "edwin"
#define DEFAULT_GEOMETRY "80x40+0+0"
+#define BLANK_CHAR ' '
+#define DEFAULT_HL 0
\f
+#define XTERM_X_PIXEL(xw, x) \
+ (((x) * (FONT_WIDTH (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
+
+#define XTERM_Y_PIXEL(xw, y) \
+ (((y) * (FONT_HEIGHT (XW_FONT (xw)))) + (XW_INTERNAL_BORDER_WIDTH (xw)))
+
#define XTERM_DRAW_CHARS(xw, x, y, s, n, gc) \
XDrawImageString \
((XW_DISPLAY (xw)), \
s, \
n)
-#define WITH_CURSOR_PRESERVED(xw, expression, body) \
-{ \
- if ((expression) && (XW_CURSOR_VISIBLE_P (xw))) \
- { \
- (XW_CURSOR_VISIBLE_P (xw)) = 0; \
- body; \
- xterm_draw_cursor (xw); \
- } \
- else \
- body; \
-}
-
-extern void xterm_erase_cursor ();
+#define CURSOR_IN_RECTANGLE(xw, x_start, x_end, y_start, y_end) \
+ (((x_start) <= (XW_CURSOR_X (xw))) \
+ && ((XW_CURSOR_X (xw)) < (x_end)) \
+ && ((y_start) <= (XW_CURSOR_Y (xw))) \
+ && ((XW_CURSOR_Y (xw)) < (y_end)))
-void
-xterm_erase_cursor (xw)
- struct xwindow * xw;
+static void
+DEFUN (xterm_erase_cursor, (xw), struct xwindow * xw)
{
- fast int x, y, index;
-
- if (! (XW_VISIBLE_P (xw)))
- return;
-
- x = (XW_CURSOR_X (xw));
- y = (XW_CURSOR_Y (xw));
- index = (XTERM_CHAR_INDEX (xw, x, y));
- XTERM_DRAW_CHARS
- (xw, x, y, (XTERM_CHAR_LOC (xw, index)), 1,
- (XTERM_HL_GC (xw, (XTERM_HL (xw, index)))));
- (XW_CURSOR_VISIBLE_P (xw)) = 0;
- return;
+ if (XW_CURSOR_VISIBLE_P (xw))
+ {
+ unsigned int x = (XW_CURSOR_X (xw));
+ unsigned int y = (XW_CURSOR_Y (xw));
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
+ XTERM_DRAW_CHARS
+ (xw, x, y,
+ (XTERM_CHAR_LOC (xw, index)),
+ 1,
+ (XTERM_HL_GC (xw, (XTERM_HL (xw, index)))));
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ }
}
-extern void xterm_draw_cursor();
-
-void
-xterm_draw_cursor (xw)
- struct xwindow * xw;
+static void
+DEFUN (xterm_draw_cursor, (xw), struct xwindow * xw)
{
- fast int x, y;
-
- if (! (XW_VISIBLE_P (xw)))
- return;
-
- /* Need option here to draw cursor as outline box when this xterm is
- not the one that input is going to. */
- x = (XW_CURSOR_X (xw));
- y = (XW_CURSOR_Y (xw));
- XTERM_DRAW_CHARS (xw, x, y,
- (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x, y)))),
- 1,
- (XW_CURSOR_GC (xw)));
- (XW_CURSOR_VISIBLE_P (xw)) = 1;
- return;
+ if ((XW_CURSOR_ENABLED_P (xw)) && (! (XW_CURSOR_VISIBLE_P (xw))))
+ {
+ unsigned int x = (XW_CURSOR_X (xw));
+ unsigned int y = (XW_CURSOR_Y (xw));
+ XTERM_DRAW_CHARS (xw, x, y,
+ (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x, y)))),
+ 1,
+ (XW_CURSOR_GC (xw)));
+ (XW_CURSOR_VISIBLE_P (xw)) = 1;
+ }
}
\f
static void
-xterm_wm_set_size_hint (xw, flags, x, y)
- struct xwindow * xw;
- long flags;
- int x, y;
+DEFUN (xterm_wm_set_size_hint, (xw, geometry_mask, x, y),
+ struct xwindow * xw AND
+ int geometry_mask AND
+ unsigned int x AND
+ unsigned int y)
{
Window window = (XW_WINDOW (xw));
- int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
+ unsigned int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
XFontStruct * font = (XW_FONT (xw));
- int fwidth = (FONT_WIDTH (font));
- int fheight = (FONT_HEIGHT (font));
+ unsigned int fwidth = (FONT_WIDTH (font));
+ unsigned int fheight = (FONT_HEIGHT (font));
XSizeHints size_hints;
-
- (size_hints . flags) = (PResizeInc | PMinSize | flags);
+ (size_hints . flags) =
+ (PResizeInc
+ | PMinSize
+ | (((geometry_mask & XValue) && (geometry_mask & YValue))
+ ? USPosition : PPosition)
+ | (((geometry_mask & WidthValue) && (geometry_mask & HeightValue))
+ ? USSize : PSize));
(size_hints . x) = x;
(size_hints . y) = y;
(size_hints . width) = (((XW_X_CSIZE (xw)) * fwidth) + extra);
(size_hints . min_width) = extra;
(size_hints . min_height) = extra;
XSetNormalHints ((XW_DISPLAY (xw)), window, (& size_hints));
- return;
}
static void
-xterm_deallocate (xw)
- struct xwindow * xw;
+DEFUN (xterm_deallocate, (xw), struct xwindow * xw)
{
free (XW_CHARACTER_MAP (xw));
free (XW_HIGHLIGHT_MAP (xw));
- return;
+}
+
+static SCHEME_OBJECT
+DEFUN (xterm_x_coordinate_map, (xw, x), struct xwindow * xw AND unsigned int x)
+{
+ return (long_to_integer (x / (FONT_WIDTH (XW_FONT (xw)))));
+}
+
+static SCHEME_OBJECT
+DEFUN (xterm_y_coordinate_map, (xw, y), struct xwindow * xw AND unsigned int y)
+{
+ return (long_to_integer (y / (FONT_HEIGHT (XW_FONT (xw)))));
+}
+
+static void
+DEFUN (xterm_copy_map_line, (xw, x_start, x_end, y1, y2),
+ struct xwindow * xw AND
+ unsigned int x_start AND
+ unsigned int x_end AND
+ unsigned int y_from AND
+ unsigned int y_to)
+{
+ {
+ char * from_scan =
+ (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_from))));
+ char * from_end =
+ (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_end, y_from))));
+ char * to_scan =
+ (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_to))));
+ while (from_scan < from_end)
+ (*to_scan++) = (*from_scan++);
+ }
+ {
+ char * from_scan =
+ (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_from))));
+ char * from_end =
+ (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_end, y_from))));
+ char * to_scan =
+ (XTERM_HL_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y_to))));
+ while (from_scan < from_end)
+ (*to_scan++) = (*from_scan++);
+ }
}
\f
static void
-xterm_dump_rectangle (xw, x, y, width, height)
- struct xwindow * xw;
- int x, y, width, height;
+DEFUN (xterm_dump_contents, (xw, x_start, x_end, y_start, y_end),
+ struct xwindow * xw AND
+ unsigned int x_start AND
+ unsigned int x_end AND
+ unsigned int y_start AND
+ unsigned int y_end)
{
- XFontStruct * font = (XW_FONT (xw));
- int fwidth = (FONT_WIDTH (font));
- int fheight = (FONT_HEIGHT (font));
- int border = (XW_INTERNAL_BORDER_WIDTH (xw));
char * character_map = (XW_CHARACTER_MAP (xw));
char * highlight_map = (XW_HIGHLIGHT_MAP (xw));
- int x_start = ((x - border) / fwidth);
- int y_start = ((y - border) / fheight);
- int x_end = ((((x + width) - border) + (fwidth - 1)) / fwidth);
- int y_end = ((((y + height) - border) + (fheight - 1)) / fheight);
- int yi;
-
- if (x_end > (XW_X_CSIZE (xw))) x_end = (XW_X_CSIZE (xw));
- if (y_end > (XW_Y_CSIZE (xw))) y_end = (XW_Y_CSIZE (xw));
if (x_start < x_end)
{
+ unsigned int yi;
for (yi = y_start; (yi < y_end); yi += 1)
{
- int index = (XTERM_CHAR_INDEX (xw, 0, yi));
- char * line_char = (& (character_map [index]));
- char * line_hl = (& (highlight_map [index]));
- int xi = x_start;
+ unsigned int index = (XTERM_CHAR_INDEX (xw, 0, yi));
+ char * line_char = (&character_map[index]);
+ char * line_hl = (&highlight_map[index]);
+ unsigned int xi = x_start;
while (1)
{
- int hl = (line_hl [xi]);
- int i = (xi + 1);
- while ((i < x_end) && ((line_hl [i]) == hl))
- i += 1;
+ unsigned int hl = (line_hl[xi]);
+ unsigned int xj = (xi + 1);
+ while ((xj < x_end) && ((line_hl[xj]) == hl))
+ xj += 1;
XTERM_DRAW_CHARS (xw, xi, yi,
- (& (line_char [xi])), (i - xi),
+ (&line_char[xi]),
+ (xj - xi),
(XTERM_HL_GC (xw, hl)));
- if (i == x_end)
+ if (xj == x_end)
break;
- xi = i;
+ xi = xj;
}
}
- if ((XW_CURSOR_VISIBLE_P (xw)) &&
- ((x_start <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < x_end)) &&
- ((y_start <= (XW_CURSOR_Y (xw))) && ((XW_CURSOR_Y (xw)) < y_end)))
- xterm_draw_cursor (xw);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_end))
+ {
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
+ }
}
- return;
-}
-\f
-#define MAKE_MAP(map, size, fill) \
-{ \
- char * MAKE_MAP_scan; \
- char * MAKE_MAP_end; \
- \
- map = (x_malloc (size)); \
- MAKE_MAP_scan = (& (map [0])); \
- MAKE_MAP_end = (MAKE_MAP_scan + size); \
- while (MAKE_MAP_scan < MAKE_MAP_end) \
- (*MAKE_MAP_scan++) = fill; \
}
-static void xterm_process_event ();
+static void
+DEFUN (xterm_dump_rectangle, (xw, x, y, width, height),
+ struct xwindow * xw AND
+ unsigned int x AND
+ unsigned int y AND
+ unsigned int width AND
+ unsigned int height)
+{
+ XFontStruct * font = (XW_FONT (xw));
+ unsigned int fwidth = (FONT_WIDTH (font));
+ unsigned int fheight = (FONT_HEIGHT (font));
+ unsigned int border = (XW_INTERNAL_BORDER_WIDTH (xw));
+ if (x < border)
+ {
+ width -= (border - x);
+ x = 0;
+ }
+ else
+ x -= border;
+ if ((x + width) > (XW_X_SIZE (xw)))
+ width = ((XW_X_SIZE (xw)) - x);
+ if (y < border)
+ {
+ height -= (border - y);
+ y = 0;
+ }
+ else
+ y -= border;
+ if ((y + height) > (XW_Y_SIZE (xw)))
+ height = ((XW_Y_SIZE (xw)) - y);
+ xterm_dump_contents (xw,
+ (x / fwidth),
+ (((x + width) + (fwidth - 1)) / fwidth),
+ (y / fheight),
+ (((y + height) + (fheight - 1)) / fheight));
+ XFlush (XW_DISPLAY (xw));
+}
+\f
+#define MIN(x, y) (((x) < (y)) ? (x) : (y))
-DEFINE_PRIMITIVE ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3,
- "(xterm-open-window display geometry suppress-map?)")
+static void
+DEFUN (xterm_process_configure_notify_event, (xw, event),
+ struct xwindow * xw AND
+ XConfigureEvent * event)
+{
+ 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));
+ if ((x_size != (XW_X_SIZE (xw))) || (y_size != (XW_Y_SIZE (xw))))
+ {
+ unsigned int x_csize = (x_size / (FONT_WIDTH (XW_FONT (xw))));
+ unsigned int y_csize = (y_size / (FONT_HEIGHT (XW_FONT (xw))));
+ char * new_char_map = (x_malloc (x_csize * y_csize));
+ char * new_hl_map = (x_malloc (x_csize * y_csize));
+ unsigned int old_x_csize = (XW_X_CSIZE (xw));
+ unsigned int min_x_csize = (MIN (x_csize, old_x_csize));
+ unsigned int min_y_csize = (MIN (y_csize, (XW_Y_CSIZE (xw))));
+ int x_clipped = (old_x_csize - x_csize);
+ char * new_scan_char = new_char_map;
+ char * new_scan_hl = new_hl_map;
+ char * new_end;
+ char * old_scan_char = (XW_CHARACTER_MAP (xw));
+ char * old_scan_hl = (XW_HIGHLIGHT_MAP (xw));
+ char * old_end;
+ unsigned int new_y = 0;
+ for (; (new_y < min_y_csize); new_y += 1)
+ {
+ old_end = (old_scan_char + min_x_csize);
+ while (old_scan_char < old_end)
+ {
+ (*new_scan_char++) = (*old_scan_char++);
+ (*new_scan_hl++) = (*old_scan_hl++);
+ }
+ if (x_clipped < 0)
+ {
+ new_end = (new_scan_char + ((unsigned int) (- x_clipped)));
+ while (new_scan_char < new_end)
+ {
+ (*new_scan_char++) = BLANK_CHAR;
+ (*new_scan_hl++) = DEFAULT_HL;
+ }
+ }
+ else if (x_clipped > 0)
+ {
+ old_scan_char += ((unsigned int) x_clipped);
+ old_scan_hl += ((unsigned int) x_clipped);
+ }
+ }
+ for (; (new_y < y_csize); new_y += 1)
+ {
+ new_end = (new_scan_char + x_csize);
+ while (new_scan_char < new_end)
+ {
+ (*new_scan_char++) = BLANK_CHAR;
+ (*new_scan_hl++) = DEFAULT_HL;
+ }
+ }
+ free (XW_CHARACTER_MAP (xw));
+ free (XW_HIGHLIGHT_MAP (xw));
+ (XW_X_SIZE (xw)) = x_size;
+ (XW_Y_SIZE (xw)) = y_size;
+ (XW_CLIP_X (xw)) = 0;
+ (XW_CLIP_Y (xw)) = 0;
+ (XW_CLIP_WIDTH (xw)) = x_size;
+ (XW_CLIP_HEIGHT (xw)) = y_size;
+ (XW_X_CSIZE (xw)) = x_csize;
+ (XW_Y_CSIZE (xw)) = y_csize;
+ (XW_CHARACTER_MAP (xw))= new_char_map;
+ (XW_HIGHLIGHT_MAP (xw))= new_hl_map;
+ xterm_dump_contents (xw, 0, 0, x_csize, y_csize);
+ xterm_wm_set_size_hint (xw, 0, 0, 0);
+ XFlush (XW_DISPLAY (xw));
+ }
+}
+\f
+static void
+DEFUN (xterm_process_event, (xw, event),
+ struct xwindow * xw AND
+ XEvent * event)
+{
+ 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;
+ }
+}
+\f
+DEFINE_PRIMITIVE ("XTERM-OPEN-WINDOW", Prim_xterm_open_window, 3, 3, 0)
{
- Display * display;
- int screen_number;
- struct drawing_attributes attributes;
- XFontStruct * font;
- int fwidth;
- int fheight;
- int border_width;
- int x_pos;
- int y_pos;
- int x_csize;
- int y_csize;
- int x_size;
- int y_size;
- char * name;
- int internal_border_width;
- int extra;
- Window window;
- long flags;
- char * character_map;
- char * highlight_map;
- struct xwindow * xw;
PRIMITIVE_HEADER (3);
-
- display = (DISPLAY_ARG (1));
- screen_number = (DefaultScreen (display));
- name = "edwin";
- x_default_attributes (display, RESOURCE_NAME, (& attributes));
- font = (attributes . font);
- border_width = (attributes . border_width);
- internal_border_width = (attributes . internal_border_width);
- fwidth = (FONT_WIDTH (font));
- fheight = (FONT_HEIGHT (font));
- extra = (2 * internal_border_width);
- x_pos = (-1);
- y_pos = (-1);
- x_csize = 80;
- y_csize = 24;
- {
- char * geometry;
- int result;
-
- geometry =
- (((ARG_REF (2)) == SHARP_F)
- ? (x_get_default
- (display, RESOURCE_NAME, "geometry", "Geometry", ((char *) 0)))
- : (STRING_ARG (2)));
- result =
- (XGeometry (display, screen_number, geometry,
- DEFAULT_GEOMETRY, border_width,
- fwidth, fheight, extra, extra,
- (& x_pos), (& y_pos), (& x_csize), (& y_csize)));
- flags = 0;
- flags |=
- (((result & XValue) && (result & YValue)) ? USPosition : PPosition);
- flags |=
- (((result & WidthValue) && (result & HeightValue)) ? USSize : PSize);
- }
{
- int map_size = (x_csize * y_csize);
- MAKE_MAP (character_map, map_size, ' ');
- MAKE_MAP (highlight_map, map_size, 0);
- }
- x_size = (x_csize * fwidth);
- y_size = (y_csize * fheight);
- window =
- (XCreateSimpleWindow
- (display, (RootWindow (display, screen_number)),
- x_pos, y_pos, (x_size + extra), (y_size + extra),
- border_width,
- (attributes . border_pixel),
- (attributes . background_pixel)));
- if (window == ((Window) 0))
- error_external_return ();
-
- xw =
- (x_make_window
- (display, window, x_size, y_size, (& attributes),
- (sizeof (struct xterm_extra)), xterm_deallocate,
- xterm_process_event));
- (XW_X_CSIZE (xw)) = x_csize;
- (XW_Y_CSIZE (xw)) = y_csize;
- (XW_CURSOR_X (xw)) = 0;
- (XW_CURSOR_Y (xw)) = 0;
- (XW_CHARACTER_MAP (xw)) = character_map;
- (XW_HIGHLIGHT_MAP (xw)) = highlight_map;
- (XW_CURSOR_VISIBLE_P (xw)) = 0;
- (XW_CHAR_BUFFER_INDEX (xw)) = 0;
- (XW_CHAR_BUFFER_LENGTH (xw)) = 4;
- (XW_CHAR_BUFFER (xw)) = (x_malloc (4));
-
- XSelectInput
- (display, window,
- (KeyPressMask | ExposureMask |
- ButtonPressMask | ButtonReleaseMask |
- StructureNotifyMask | FocusChangeMask |
- PointerMotionHintMask | ButtonMotionMask |
- LeaveWindowMask | EnterWindowMask));
- xterm_wm_set_size_hint (xw, flags, x_pos, y_pos);
- XStoreName (display, window, name);
- XSetIconName (display, window, name);
-
- if ((ARG_REF (3)) == SHARP_F)
+ struct xdisplay * xd = (x_display_arg (1));
+ Display * display = (XD_DISPLAY (xd));
+ struct drawing_attributes attributes;
+ struct xwindow_methods methods;
+ x_default_attributes (display, RESOURCE_NAME, (&attributes));
+ (methods . deallocator) = xterm_deallocate;
+ (methods . event_processor) = xterm_process_event;
+ (methods . x_coordinate_map) = xterm_x_coordinate_map;
+ (methods . y_coordinate_map) = xterm_y_coordinate_map;
{
- (XW_VISIBLE_P (xw)) = 1;
- XMapWindow (display, window);
- XFlush (display);
+ unsigned int extra = (2 * (attributes . internal_border_width));
+ int x_pos = (-1);
+ int y_pos = (-1);
+ int x_csize = 80;
+ int y_csize = 24;
+ int geometry_mask =
+ (XGeometry
+ (display, (DefaultScreen (display)),
+ (((ARG_REF (2)) == SHARP_F)
+ ? (x_get_default
+ (display, RESOURCE_NAME, "geometry", "Geometry", 0))
+ : (STRING_ARG (2))),
+ DEFAULT_GEOMETRY, (attributes . border_width),
+ (FONT_WIDTH (attributes . font)), (FONT_HEIGHT (attributes . font)),
+ extra, extra, (&x_pos), (&y_pos), (&x_csize), (&y_csize)));
+ unsigned int x_size = (x_csize * (FONT_WIDTH (attributes . font)));
+ unsigned int y_size = (y_csize * (FONT_HEIGHT (attributes . font)));
+ Window window =
+ (XCreateSimpleWindow
+ (display, (RootWindow (display, (DefaultScreen (display)))),
+ x_pos, y_pos, (x_size + extra), (y_size + extra),
+ (attributes . border_width),
+ (attributes . border_pixel),
+ (attributes . background_pixel)));
+ if (window == 0)
+ error_external_return ();
+ {
+ struct xwindow * xw =
+ (x_make_window
+ (xd, window, x_size, y_size, (&attributes), (&methods),
+ (sizeof (struct xterm_extra))));
+ unsigned int map_size = (x_csize * y_csize);
+ (XW_X_CSIZE (xw)) = x_csize;
+ (XW_Y_CSIZE (xw)) = y_csize;
+ (XW_CURSOR_X (xw)) = 0;
+ (XW_CURSOR_Y (xw)) = 0;
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ (XW_CURSOR_ENABLED_P (xw)) = 1;
+ {
+ char * scan = (x_malloc (map_size));
+ char * end = (scan + map_size);
+ (XW_CHARACTER_MAP (xw)) = scan;
+ while (scan < end)
+ (*scan++) = BLANK_CHAR;
+ }
+ {
+ char * scan = (x_malloc (map_size));
+ char * end = (scan + map_size);
+ (XW_HIGHLIGHT_MAP (xw)) = scan;
+ while (scan < end)
+ (*scan++) = DEFAULT_HL;
+ }
+ xterm_wm_set_size_hint (xw, geometry_mask, x_pos, y_pos);
+ XStoreName (display, window, "scheme-terminal");
+ XSetIconName (display, window, "scheme-terminal");
+ if ((ARG_REF (3)) == SHARP_F)
+ {
+ XMapWindow (display, window);
+ XFlush (display);
+ }
+ PRIMITIVE_RETURN (XW_TO_OBJECT (xw));
+ }
}
-
- PRIMITIVE_RETURN (x_window_to_object (xw));
+ }
}
\f
DEFINE_PRIMITIVE ("XTERM-X-SIZE", Prim_xterm_x_size, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_X_CSIZE (WINDOW_ARG (1))));
+ PRIMITIVE_RETURN (long_to_integer (XW_X_CSIZE (x_window_arg (1))));
}
DEFINE_PRIMITIVE ("XTERM-Y-SIZE", Prim_xterm_y_size, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_Y_CSIZE (WINDOW_ARG (1))));
+ PRIMITIVE_RETURN (long_to_integer (XW_Y_CSIZE (x_window_arg (1))));
}
DEFINE_PRIMITIVE ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0)
int extra;
XFontStruct * font;
PRIMITIVE_HEADER (3);
- xw = (WINDOW_ARG (1));
+ xw = (x_window_arg (1));
extra = (2 * (XW_INTERNAL_BORDER_WIDTH (xw)));
font = (XW_FONT (xw));
XResizeWindow
PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("XTERM-BUTTON", Prim_xterm_button, 1, 1, 0)
+DEFINE_PRIMITIVE ("XTERM-ERASE-CURSOR", Prim_xterm_erase_cursor, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_BUTTON (WINDOW_ARG (1))));
+ (XW_CURSOR_ENABLED_P (x_window_arg (1))) = 0;
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("XTERM-POINTER-X", Prim_xterm_pointer_x, 1, 1, 0)
+DEFINE_PRIMITIVE ("XTERM-DRAW-CURSOR", Prim_xterm_draw_cursor, 1, 1, 0)
{
PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_POINTER_X (WINDOW_ARG (1))));
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ (XW_CURSOR_ENABLED_P (xw)) = 1;
+ xterm_draw_cursor (xw);
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
-DEFINE_PRIMITIVE ("XTERM-POINTER-Y", Prim_xterm_pointer_y, 1, 1, 0)
-{
- PRIMITIVE_HEADER (1);
- PRIMITIVE_RETURN (long_to_integer (XW_POINTER_Y (WINDOW_ARG (1))));
-}
-\f
DEFINE_PRIMITIVE ("XTERM-WRITE-CURSOR!", Prim_xterm_write_cursor, 3, 3, 0)
{
- fast struct xwindow * xw;
- fast int x, y;
PRIMITIVE_HEADER (3);
-
- xw = (WINDOW_ARG (1));
- x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
- y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
- if (XW_CURSOR_VISIBLE_P (xw))
- xterm_erase_cursor (xw);
- (XW_CURSOR_X (xw)) = x;
- (XW_CURSOR_Y (xw)) = y;
- xterm_draw_cursor (xw);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
+ unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+ if ((x != (XW_CURSOR_X (xw))) || (y != (XW_CURSOR_Y (xw))))
+ {
+ xterm_erase_cursor (xw);
+ (XW_CURSOR_X (xw)) = x;
+ (XW_CURSOR_Y (xw)) = y;
+ }
+ xterm_draw_cursor (xw);
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-
+\f
DEFINE_PRIMITIVE ("XTERM-WRITE-CHAR!", Prim_xterm_write_char, 5, 5, 0)
{
- struct xwindow * xw;
- int x, y;
- int c;
- int hl;
- int index;
- char * map_ptr;
PRIMITIVE_HEADER (5);
-
- xw = (WINDOW_ARG (1));
- x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
- y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
- c = (arg_ascii_char (4));
- hl = (HL_ARG (5));
- index = (XTERM_CHAR_INDEX (xw, x, y));
- map_ptr = (XTERM_CHAR_LOC (xw, index));
- (*map_ptr) = c;
- (XTERM_HL (xw, index)) = hl;
- WITH_CURSOR_PRESERVED
- (xw, ((x == (XW_CURSOR_X (xw))) && (y == (XW_CURSOR_Y (xw)))),
- {
- XTERM_DRAW_CHARS (xw, x, y, map_ptr, 1, (XTERM_HL_GC (xw, (xw, hl))));
- });
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
+ unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+ int c = (arg_ascii_char (4));
+ unsigned int hl = (HL_ARG (5));
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
+ char * map_ptr = (XTERM_CHAR_LOC (xw, index));
+ (*map_ptr) = c;
+ (XTERM_HL (xw, index)) = hl;
+ XTERM_DRAW_CHARS (xw, x, y, map_ptr, 1, (XTERM_HL_GC (xw, (xw, hl))));
+ if (((XW_CURSOR_X (xw)) == x) && ((XW_CURSOR_Y (xw)) == y))
+ {
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
+ }
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
-\f
+
DEFINE_PRIMITIVE ("XTERM-WRITE-SUBSTRING!", Prim_xterm_write_substring, 7, 7, 0)
{
- struct xwindow * xw;
- int x, y;
- SCHEME_OBJECT string;
- int start, end;
- int hl;
- int length;
- unsigned char * string_scan;
- unsigned char * string_end;
- int index;
- char * char_start;
- char * char_scan;
- char * hl_scan;
PRIMITIVE_HEADER (7);
- xw = (WINDOW_ARG (1));
- x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
- y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
CHECK_ARG (4, STRING_P);
- string = (ARG_REF (4));
- end = (arg_index_integer (6, ((STRING_LENGTH (string)) + 1)));
- start = (arg_index_integer (5, (end + 1)));
- hl = (HL_ARG (7));
- length = (end - start);
- if ((x + length) > (XW_X_CSIZE (xw)))
- error_bad_range_arg (2);
- string_scan = (STRING_LOC (string, start));
- string_end = (STRING_LOC (string, end));
- index = (XTERM_CHAR_INDEX (xw, x, y));
- char_start = (XTERM_CHAR_LOC (xw, index));
- char_scan = char_start;
- hl_scan = (XTERM_HL_LOC (xw, index));
- while (string_scan < string_end)
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x = (arg_index_integer (2, (XW_X_CSIZE (xw))));
+ unsigned int y = (arg_index_integer (3, (XW_Y_CSIZE (xw))));
+ SCHEME_OBJECT string = (ARG_REF (4));
+ unsigned int end = (arg_index_integer (6, ((STRING_LENGTH (string)) + 1)));
+ unsigned int start = (arg_index_integer (5, (end + 1)));
+ unsigned int hl = (HL_ARG (7));
+ unsigned int length = (end - start);
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x, y));
+ if ((x + length) > (XW_X_CSIZE (xw)))
+ error_bad_range_arg (2);
{
- (*char_scan++) = (*string_scan++);
- (*hl_scan++) = hl;
+ unsigned char * string_scan = (STRING_LOC (string, start));
+ unsigned char * string_end = (STRING_LOC (string, end));
+ char * char_scan = (XTERM_CHAR_LOC (xw, index));
+ char * hl_scan = (XTERM_HL_LOC (xw, index));
+ while (string_scan < string_end)
+ {
+ (*char_scan++) = (*string_scan++);
+ (*hl_scan++) = hl;
+ }
}
- WITH_CURSOR_PRESERVED
- (xw,
- ((y == (XW_CURSOR_Y (xw))) &&
- ((x <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < (x + length)))),
- {
- XTERM_DRAW_CHARS (xw, x, y, char_start, length, (XTERM_HL_GC (xw, hl)));
- });
+ XTERM_DRAW_CHARS
+ (xw, x, y, (XTERM_CHAR_LOC (xw, index)), length, (XTERM_HL_GC (xw, hl)));
+ if ((x <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < (x + length))
+ && (y == (XW_CURSOR_Y (xw))))
+ {
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
+ }
+ }
PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
+static void
+DEFUN (xterm_clear_rectangle, (xw, x_start, x_end, y_start, y_end, hl),
+ struct xwindow * xw AND
+ unsigned int x_start AND
+ unsigned int x_end AND
+ unsigned int y_start AND
+ unsigned int y_end AND
+ unsigned int hl)
+{
+ unsigned int x_length = (x_end - x_start);
+ unsigned int y;
+ for (y = y_start; (y < y_end); y += 1)
+ {
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
+ {
+ char * scan = (XTERM_CHAR_LOC (xw, index));
+ char * end = (scan + x_length);
+ while (scan < end)
+ (*scan++) = BLANK_CHAR;
+ }
+ {
+ char * scan = (XTERM_HL_LOC (xw, index));
+ char * end = (scan + x_length);
+ while (scan < end)
+ (*scan++) = hl;
+ }
+ }
+ if (hl == 0)
+ XClearArea ((XW_DISPLAY (xw)),
+ (XW_WINDOW (xw)),
+ (XTERM_X_PIXEL (xw, x_start)),
+ (XTERM_Y_PIXEL (xw, y_start)),
+ (x_length * (FONT_WIDTH (XW_FONT (xw)))),
+ ((y_end - y_start) * (FONT_HEIGHT (XW_FONT (xw)))),
+ False);
+ else
+ {
+ GC hl_gc = (XTERM_HL_GC (xw, hl));
+ for (y = y_start; (y < y_end); y += 1)
+ XTERM_DRAW_CHARS
+ (xw, x_start, y,
+ (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, x_start, y)))),
+ x_length, hl_gc);
+ }
+}
+
DEFINE_PRIMITIVE ("XTERM-CLEAR-RECTANGLE!", Prim_xterm_clear_rectangle, 6, 6, 0)
{
- struct xwindow * xw;
- int start_x, start_y, end_x, end_y;
- int hl;
- int x_length;
PRIMITIVE_HEADER (6);
-
- xw = (WINDOW_ARG (1));
- end_x = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
- end_y = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
- start_x = (arg_index_integer (2, (end_x + 1)));
- start_y = (arg_index_integer (4, (end_y + 1)));
- hl = (HL_ARG (6));
- if ((start_x == end_x) || (start_y == end_y))
- goto done;
- x_length = (end_x - start_x);
{
- int y;
- int index;
- fast char * char_scan;
- fast char * char_end;
- fast char * hl_scan;
-
- for (y = start_y; (y < end_y) ; (y += 1))
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+ unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+ unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
+ unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+ unsigned int hl = (HL_ARG (6));
+ if ((x_start < x_end) && (y_start < y_end))
{
- index = (XTERM_CHAR_INDEX (xw, start_x, y));
- char_scan = (XTERM_CHAR_LOC (xw, index));
- char_end = (char_scan + x_length);
- hl_scan = (XTERM_HL_LOC (xw, index));
- while (char_scan < char_end)
+ xterm_clear_rectangle (xw, x_start, x_end, y_start, y_end, hl);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_end))
{
- (*char_scan++) = ' ';
- (*hl_scan++) = hl;
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
}
}
}
- WITH_CURSOR_PRESERVED
- (xw,
- (((start_x <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < end_x)) &&
- ((start_y <= (XW_CURSOR_Y (xw))) && ((XW_CURSOR_Y (xw)) < end_y))),
- {
- if (hl == 0)
- XClearArea ((XW_DISPLAY (xw)), (XW_WINDOW (xw)),
- (XTERM_X_PIXEL (xw, start_x)),
- (XTERM_Y_PIXEL (xw, start_y)),
- ((end_x - start_x) * (FONT_WIDTH (XW_FONT (xw)))),
- ((end_y - start_y) * (FONT_HEIGHT (XW_FONT (xw)))),
- False);
- else
- {
- fast int y;
- GC hl_gc;
-
- hl_gc = (XTERM_HL_GC (xw, hl));
- for (y = start_y; (y < end_y) ; (y += 1))
- XTERM_DRAW_CHARS
- (xw,
- start_x,
- y,
- (XTERM_CHAR_LOC (xw, (XTERM_CHAR_INDEX (xw, start_x, y)))),
- x_length,
- hl_gc);
- }
- });
- done:
PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
-
-DEFINE_PRIMITIVE ("XTERM-READ-CHARS", Prim_xterm_read_chars, 2, 2, 0)
+static void
+DEFUN (xterm_scroll_lines_up,
+ (xw, x_start, x_end, y_start, y_end, lines, hl),
+ struct xwindow * xw AND
+ unsigned int x_start AND
+ unsigned int x_end AND
+ unsigned int y_start AND
+ unsigned int y_end AND
+ unsigned int lines AND
+ unsigned int hl)
{
- struct xwindow * xw;
- int interval;
- int found_index;
- long time_limit;
- XEvent event;
- extern long OS_real_time_clock ();
- PRIMITIVE_HEADER (2);
-
- xw = (WINDOW_ARG (1));
- interval =
- (((ARG_REF (2)) == SHARP_F) ? (-1) : (arg_nonnegative_integer (2)));
- if (interval >= 0)
- time_limit = ((OS_real_time_clock ()) + interval);
-
- x_process_events();
- while (1) {
- if ((XW_CHAR_BUFFER_INDEX (xw) != 0) ||
- (interval == 0)){
- break;
- } else if (interval < 0) {
- x_wait_for_event ();
- break;
- } else if ((OS_real_time_clock ()) >= time_limit) {
- break;
- } else {
- x_process_events();
- }
- }
-
- /* If we got characters, return them */
- if ((found_index = XW_CHAR_BUFFER_INDEX (xw)) != 0) {
- XW_CHAR_BUFFER_INDEX (xw) = 0;
- PRIMITIVE_RETURN (memory_to_string (found_index,
- XW_CHAR_BUFFER (xw)));
+ {
+ unsigned int y_to = y_start;
+ unsigned int y_from = (y_to + lines);
+ while (y_from < y_end)
+ xterm_copy_map_line (xw, x_start, x_end, (y_from++), (y_to++));
}
- /* If we're in a read with timeout, and we stopped before the
- timeout was finished, return the amount remaining. */
- if (interval > 0)
- interval = (time_limit - (OS_real_time_clock ()));
- if (interval <= 0)
- PRIMITIVE_RETURN (SHARP_F);
- PRIMITIVE_RETURN (long_to_integer (interval));
+ XCopyArea ((XW_DISPLAY (xw)),
+ (XW_WINDOW (xw)),
+ (XW_WINDOW (xw)),
+ (XW_NORMAL_GC (xw)),
+ (XTERM_X_PIXEL (xw, x_start)),
+ (XTERM_Y_PIXEL (xw, (y_start + lines))),
+ ((x_end - x_start) * (FONT_WIDTH (XW_FONT (xw)))),
+ (((y_end - y_start) - lines) * (FONT_HEIGHT (XW_FONT (xw)))),
+ (XTERM_X_PIXEL (xw, x_start)),
+ (XTERM_Y_PIXEL (xw, y_start)));
+ xterm_clear_rectangle (xw, x_start, x_end, (y_end - lines), y_end, hl);
}
-\f
-#define min(x,y) (((x)<(y)) ? (x) : (y))
-
-/* This procedure courtesy of Mike Clarkson (mike@ists.ists.ca) */
-extern void xterm_dump_contents();
-
-void
-xterm_dump_contents (xw, x_start, x_end, y_start, y_end)
- struct xwindow *xw;
- int x_start, x_end, y_start, y_end;
+DEFINE_PRIMITIVE ("XTERM-SCROLL-LINES-UP", Prim_xterm_scroll_lines_up, 7, 7,
+ "(XTERM-SCROLL-LINES-UP XTERM X-START X-END Y-START Y-END LINES HL)\n\
+Scroll the contents of the region up by LINES, clearing with HL.")
{
- char *character_map = (XW_CHARACTER_MAP (xw));
- char *highlight_map = (XW_HIGHLIGHT_MAP (xw));
- int x_width = (x_end - x_start);
- int xi, yi;
-
- if (x_end > (XW_X_CSIZE (xw)))
- {
- x_end = (XW_X_CSIZE (xw));
- }
- if (y_end > (XW_Y_CSIZE (xw)))
- {
- y_end = (XW_Y_CSIZE (xw));
- }
- if (x_start < x_end)
+ PRIMITIVE_HEADER (7);
{
- for (yi = y_start; (yi < y_end); yi += 1)
- {
- int index = (XTERM_CHAR_INDEX (xw, 0, yi));
- char * line_char = (& (character_map [index]));
- char * line_hl = (& (highlight_map [index]));
- int xi = x_start;
- while (1)
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+ unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
+ unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+ unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+ unsigned int lines = (arg_index_integer (6, ((y_end - y_start) + 1)));
+ unsigned int hl = (HL_ARG (7));
+ if ((lines > 0) && (x_start < x_end) && (y_start < y_end))
{
- int hl = (line_hl [xi]);
- int i = (xi + 1);
- while ((i < x_end) && ((line_hl [i]) == hl))
- {
- i += 1;
- }
- XTERM_DRAW_CHARS (xw, xi, yi,
- (& (line_char [xi])), (i - xi),
- (XTERM_HL_GC (xw, hl)));
- if (i == x_end)
- break;
- xi = i;
+ unsigned int y_mid = (y_start + lines);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_mid, y_end))
+ {
+ xterm_erase_cursor (xw);
+ xterm_scroll_lines_up
+ (xw, x_start, x_end, y_start, y_end, lines, hl);
+ xterm_draw_cursor (xw);
+ }
+ else
+ {
+ xterm_scroll_lines_up
+ (xw, x_start, x_end, y_start, y_end, lines, hl);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_mid))
+ {
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
+ }
+ }
}
- }
- if ((XW_CURSOR_VISIBLE_P (xw)) &&
- ((x_start <= (XW_CURSOR_X (xw))) && ((XW_CURSOR_X (xw)) < x_end)) &&
- ((y_start <= (XW_CURSOR_Y (xw))) && ((XW_CURSOR_Y (xw)) < y_end)))
- {
- xterm_draw_cursor (xw);
- }
}
- return;
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
\f
-static XComposeStatus compose_status;
-
static void
-xterm_process_event (exw, event)
- struct xwindow *exw;
- XEvent * event;
+DEFUN (xterm_scroll_lines_down,
+ (xw, x_start, x_end, y_start, y_end, lines, hl),
+ struct xwindow * xw AND
+ unsigned int x_start AND
+ unsigned int x_end AND
+ unsigned int y_start AND
+ unsigned int y_end AND
+ unsigned int lines AND
+ unsigned int hl)
{
- switch (event -> type)
- {
- case KeyPress:
+ {
+ unsigned int y_to = y_end;
+ unsigned int y_from = (y_to - lines);
+ while (y_from > y_start)
+ xterm_copy_map_line (xw, x_start, x_end, (--y_from), (--y_to));
+ }
+ XCopyArea ((XW_DISPLAY (xw)),
+ (XW_WINDOW (xw)),
+ (XW_WINDOW (xw)),
+ (XW_NORMAL_GC (xw)),
+ (XTERM_X_PIXEL (xw, x_start)),
+ (XTERM_Y_PIXEL (xw, y_start)),
+ ((x_end - x_start) * (FONT_WIDTH (XW_FONT (xw)))),
+ (((y_end - y_start) - lines) * (FONT_HEIGHT (XW_FONT (xw)))),
+ (XTERM_X_PIXEL (xw, x_start)),
+ (XTERM_Y_PIXEL (xw, (y_start + lines))));
+ xterm_clear_rectangle (xw, x_start, x_end, y_start, (y_start + lines), hl);
+}
+
+DEFINE_PRIMITIVE ("XTERM-SCROLL-LINES-DOWN", Prim_xterm_scroll_lines_down, 7, 7,
+ "(XTERM-SCROLL-LINES-DOWN XTERM X-START X-END Y-START Y-END LINES HL)\n\
+Scroll the contents of the region down by LINES, clearing with HL.")
+{
+ PRIMITIVE_HEADER (7);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+ unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
+ unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+ unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+ unsigned int lines = (arg_index_integer (6, ((y_end - y_start) + 1)));
+ unsigned int hl = (HL_ARG (7));
+ if ((lines > 0) && (x_start < x_end) && (y_start < y_end))
{
- char copy_buffer [80] ;
- int buffer_length;
- int buffer_index;
- char * buffer;
- fast int nbytes;
- fast char * scan_buffer;
- fast char * scan_copy;
- fast char * end_copy;
- KeySym keysym;
-
- buffer_length = XW_CHAR_BUFFER_LENGTH (exw);
- buffer_index = XW_CHAR_BUFFER_INDEX (exw);
- buffer = XW_CHAR_BUFFER (exw);
-
-
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_KEY_PRESS;
- nbytes =
- (XLookupString ((& (event -> xkey)),
- (& (copy_buffer [0])),
- (sizeof (copy_buffer)),
- (& keysym),
- (& compose_status)));
- if (x_debug)
+ unsigned int y_mid = (y_end - lines);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_start, y_mid))
{
- fprintf (stderr, "\nX event: KeyPress, key=%s\n", copy_buffer);
+ xterm_erase_cursor (xw);
+ xterm_scroll_lines_down
+ (xw, x_start, x_end, y_start, y_end, lines, hl);
+ xterm_draw_cursor (xw);
}
- if ((IsFunctionKey (keysym)) ||
- (IsCursorKey (keysym)) ||
- (IsKeypadKey (keysym)) ||
- (IsMiscFunctionKey (keysym)))
- break;
- if (((event -> xkey . state) & Mod1Mask) != 0)
- (copy_buffer [0]) |= 0x80;
- if (nbytes > (buffer_length - buffer_index))
+ else
{
- buffer_length *= 2;
- buffer = (x_realloc (buffer, buffer_length));
- XW_CHAR_BUFFER (exw) = buffer;
- XW_CHAR_BUFFER_LENGTH (exw) = buffer_length;
+ xterm_scroll_lines_down
+ (xw, x_start, x_end, y_start, y_end, lines, hl);
+ if (CURSOR_IN_RECTANGLE (xw, x_start, x_end, y_mid, y_end))
+ {
+ (XW_CURSOR_VISIBLE_P (xw)) = 0;
+ xterm_draw_cursor (xw);
+ }
}
- scan_buffer = (buffer + buffer_index);
- scan_copy = (& (copy_buffer [0]));
- end_copy = (scan_copy + nbytes);
- while (scan_copy < end_copy)
- (*scan_buffer++) = (*scan_copy++);
- XW_CHAR_BUFFER_INDEX (exw) = (scan_buffer - buffer);
- break;
- }
-
- case ConfigureNotify:
- if (x_debug)
- {
- fprintf (stderr, "\nX event: ConfigureNotify\n");
}
- if (exw != ((struct xwindow *) 0))
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
+}
+\f
+DEFINE_PRIMITIVE ("XTERM-SAVE-CONTENTS", Prim_xterm_save_contents, 5, 5,
+ "(XTERM-SAVE-CONTENTS XW X-START X-END Y-START Y-END)\n\
+Get the contents of the terminal screen rectangle as a string.\n\
+The string contains alternating (CHARACTER, HIGHLIGHT) pairs.\n\
+The pairs are organized in row-major order from (X-START, Y-START).")
+{
+ PRIMITIVE_HEADER (5);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+ unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+ unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
+ unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+ unsigned int x_length = (x_end - x_start);
+ unsigned int string_length = (2 * x_length * (y_end - y_start));
+ SCHEME_OBJECT string = (allocate_string (string_length));
+ if (string_length > 0)
{
- int extra = (2 * (XW_INTERNAL_BORDER_WIDTH (exw)));
- int x_size = (((event -> xconfigure) . width) - extra);
- int y_size = (((event -> xconfigure) . height) - extra);
-
- if ((x_size != (XW_X_SIZE (exw))) || (y_size != (XW_Y_SIZE (exw))))
- {
- XFontStruct * font = (XW_FONT (exw));
- int x_csize = (x_size / (FONT_WIDTH (font)));
- int y_csize = (y_size / (FONT_HEIGHT (font)));
- int map_size = (x_csize * y_csize);
- char * new_char_map;
- char * new_hl_map;
- int new_y;
- fast char * char_scan, * new_char_scan;
- fast char * char_end;
- fast char * hl_scan, * new_hl_scan;
- fast int min_y_csize = min (y_csize, XW_Y_CSIZE(exw));
-
- MAKE_MAP (new_char_map, map_size, ' ');
- MAKE_MAP (new_hl_map, map_size, 0);
-
- for (new_y = 0; (new_y < min_y_csize); new_y++ )
+ char * string_scan = ((char *) (STRING_LOC (string, 0)));
+ unsigned int y;
+ for (y = y_start; (y < y_end); y += 1)
{
- char_scan = ((XW_CHARACTER_MAP (exw)) +
- (new_y * (XW_X_CSIZE (exw))));
- char_end = (char_scan + min(x_csize, (XW_X_CSIZE (exw))));
- hl_scan = ((XW_HIGHLIGHT_MAP (exw)) +
- (new_y * (XW_X_CSIZE (exw))));
- new_char_scan = new_char_map + (new_y * x_csize);
- new_hl_scan = new_hl_map + (new_y * x_csize);
-
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
+ char * char_scan = (XTERM_CHAR_LOC (xw, index));
+ char * char_end = (char_scan + x_length);
+ char * hl_scan = (XTERM_HL_LOC (xw, index));
while (char_scan < char_end)
- {
- (*new_char_scan++) = (*char_scan++) ;
- (*new_hl_scan++) = (*hl_scan++) ;
- }
+ {
+ (*string_scan++) = (*char_scan++);
+ (*string_scan++) = (*hl_scan++);
+ }
}
-
- (XW_X_SIZE (exw)) = x_size;
- (XW_Y_SIZE (exw)) = y_size;
- (XW_X_CSIZE (exw)) = x_csize;
- (XW_Y_CSIZE (exw)) = y_csize;
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_RESIZED;
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_CONFIGURE;
- free (XW_CHARACTER_MAP (exw));
- free (XW_HIGHLIGHT_MAP (exw));
- (XW_CHARACTER_MAP (exw))= new_char_map;
- (XW_HIGHLIGHT_MAP (exw))= new_hl_map;
-
- (void) xterm_dump_contents (exw, 0, 0, x_csize, y_csize);
- xterm_wm_set_size_hint (exw, 0, 0, 0);
- }
- }
- break;
-
- case MapNotify:
- if (x_debug) fprintf (stderr, "\nX event: MapNotify\n");
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_MAP;
- (XW_VISIBLE_P (exw)) = 1;
- break;
-
- case UnmapNotify:
- if (x_debug) fprintf (stderr, "\nX event: UnmapNotify\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_UNMAP;
- (XW_VISIBLE_P (exw)) = 0;
- }
- break;
-
- case Expose:
- if (x_debug) fprintf (stderr, "\nX event: Expose\n");
- if (exw != ((struct xwindow *) 0)) {
- xterm_dump_rectangle (exw,
- ((event -> xexpose) . x),
- ((event -> xexpose) . y),
- ((event -> xexpose) . width),
- ((event -> xexpose) . height));
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_EXPOSE;
- }
- break;
-
- case GraphicsExpose:
- if (x_debug) fprintf (stderr, "\nX event: GraphicsExpose\n");
- if (exw != ((struct xwindow *) 0)) {
- xterm_dump_rectangle (exw,
- ((event -> xgraphicsexpose) . x),
- ((event -> xgraphicsexpose) . y),
- ((event -> xgraphicsexpose) . width),
- ((event -> xgraphicsexpose) . height));
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_GRAPHICS_EXPOSE;
- }
- break;
-
- case ButtonPress:
- {
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = (XTERM_X_CHARACTER (exw, ((event -> xbutton) . x)));
- int pointer_y = (XTERM_Y_CHARACTER (exw, ((event -> xbutton) . y)));
- if (button == (-1)) break;
- (XW_BUTTON (exw)) = button;
- (XW_POINTER_X (exw)) = pointer_x;
- (XW_POINTER_Y (exw)) = pointer_y;
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_BUTTON_DOWN;
- if (x_debug)
- fprintf (stderr, "\nX event: ButtonPress: Button=%d, X=%d, Y=%d\n",
- button, pointer_x, pointer_y);
}
- break;
+ PRIMITIVE_RETURN (string);
+ }
+}
- case ButtonRelease:
+DEFINE_PRIMITIVE ("XTERM-RESTORE-CONTENTS", Prim_xterm_restore_contents, 6, 6,
+ "(xterm-restore-contents xterm x-start x-end y-start y-end contents)\n\
+Replace the terminal screen rectangle with CONTENTS.\n\
+See `XTERM-SCREEN-CONTENTS' for the format of CONTENTS.")
+{
+ PRIMITIVE_HEADER (6);
+ CHECK_ARG (6, STRING_P);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ unsigned int x_end = (arg_index_integer (3, ((XW_X_CSIZE (xw)) + 1)));
+ unsigned int y_end = (arg_index_integer (5, ((XW_Y_CSIZE (xw)) + 1)));
+ unsigned int x_start = (arg_index_integer (2, (x_end + 1)));
+ unsigned int y_start = (arg_index_integer (4, (y_end + 1)));
+ unsigned int x_length = (x_end - x_start);
+ unsigned int string_length = (2 * x_length * (y_end - y_start));
+ SCHEME_OBJECT string = (ARG_REF (6));
+ if ((STRING_LENGTH (string)) != string_length)
+ error_bad_range_arg (6);
+ if (string_length > 0)
{
- int button = (check_button ((event -> xbutton) . button));
- int pointer_x = (XTERM_X_CHARACTER (exw, ((event -> xbutton) . x)));
- int pointer_y = (XTERM_Y_CHARACTER (exw, ((event -> xbutton) . y)));
- if (button == (-1)) break;
- (XW_BUTTON (exw)) = button;
- (XW_POINTER_X (exw)) = pointer_x;
- (XW_POINTER_Y (exw)) = pointer_y;
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_BUTTON_UP;
- if (x_debug)
- fprintf (stderr, "\nX event: ButtonRelease: Button=%d, X=%d, Y=%d\n",
- button, pointer_x, pointer_y);
- }
- break;
-
- case NoExpose:
- if (x_debug) fprintf (stderr, "\nX event: NoExpose\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_NO_EXPOSE;
- }
- break;
-
- case EnterNotify:
- if (x_debug) fprintf (stderr, "\nX event: EnterNotify\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_ENTER;
- }
- break;
-
- case LeaveNotify:
- if (x_debug) fprintf (stderr, "\nX event: LeaveNotify\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_LEAVE;
- }
- break;
-
- case FocusIn:
- if (x_debug) fprintf (stderr, "\nX event: FocusIn\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_FOCUS_IN;
- }
- break;
-
- case FocusOut:
- if (x_debug) fprintf (stderr, "\nX event: FocusOut\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_FOCUS_OUT;
- }
- break;
-
- case MotionNotify:
- if (x_debug) fprintf (stderr, "\nX event: MotionNotify\n");
- if (exw != ((struct xwindow *) 0)) {
- (XW_EVENT_FLAGS (exw)) |= EVENT_FLAG_MOTION;
+ char * string_scan = ((char *) (STRING_LOC (string, 0)));
+ unsigned int y;
+ for (y = y_start; (y < y_end); y += 1)
+ {
+ unsigned int index = (XTERM_CHAR_INDEX (xw, x_start, y));
+ char * char_scan = (XTERM_CHAR_LOC (xw, index));
+ char * char_end = (char_scan + x_length);
+ char * hl_scan = (XTERM_HL_LOC (xw, index));
+ while (char_scan < char_end)
+ {
+ (*char_scan++) = (*string_scan++);
+ (*hl_scan++) = (*string_scan++);
+ }
+ }
+ xterm_dump_contents (xw, x_start, x_end, y_start, y_end);
}
- break;
-
- default:
- if (x_debug) fprintf (stderr, "\nX event: %d", (event -> type));
- break;
- }
- return;
+ }
+ PRIMITIVE_RETURN (UNSPECIFIC);
}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.44 1990/09/11 19:50:29 cph Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.45 1990/10/02 22:52:17 cph Exp $
Copyright (c) 1988, 1989, 1990 Massachusetts Institute of Technology
MIT in each case. */
/* This file contains version information for the microcode. */
-\f
+
/* Scheme system release version */
#ifndef RELEASE
#define VERSION 11
#endif
#ifndef SUBVERSION
-#define SUBVERSION 44
+#define SUBVERSION 45
#endif
#ifndef UCODE_TABLES_FILENAME
projects / mit-scheme.git / commitdiff