From 4be641004c744f5bbc20afa01740bc3d3f1da609 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 2 Oct 1990 22:52:47 +0000 Subject: [PATCH] Extensive rewrite of X11 interface. New event-handling model, cleanup of several bugs, general reformatting of code. Requires runtime version 14.97 or later, and edwin 3.21 or later. --- v7/src/microcode/starbasx.c | 23 +- v7/src/microcode/unxutl/ymkfile | 14 +- v7/src/microcode/version.h | 6 +- v7/src/microcode/x11.h | 212 ++-- v7/src/microcode/x11base.c | 1683 ++++++++++++++----------------- v7/src/microcode/x11graph.c | 536 ++++------ v7/src/microcode/x11term.c | 1374 ++++++++++++------------- v8/src/microcode/version.h | 6 +- 8 files changed, 1769 insertions(+), 2085 deletions(-) diff --git a/v7/src/microcode/starbasx.c b/v7/src/microcode/starbasx.c index 04f9b7880..4b0e59efa 100644 --- a/v7/src/microcode/starbasx.c +++ b/v7/src/microcode/starbasx.c @@ -1,8 +1,8 @@ /* -*-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 @@ -43,15 +43,14 @@ DEFINE_PRIMITIVE ("X11-WINDOW-STARBASE-FILENAME", Prim_x11_window_starbase_filen "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))); + } } diff --git a/v7/src/microcode/unxutl/ymkfile b/v7/src/microcode/unxutl/ymkfile index 3f0bd41f0..96fcb84c6 100644 --- a/v7/src/microcode/unxutl/ymkfile +++ b/v7/src/microcode/unxutl/ymkfile @@ -1,6 +1,6 @@ /* -*-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 @@ -128,8 +128,8 @@ MIT in each case. */ #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 */ @@ -596,14 +596,10 @@ Ppband.o : config.h types.h const.h object.h sdata.h fasl.h load.c 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 diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index 400f2fe9e..eb0652e14 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-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 @@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. */ /* This file contains version information for the microcode. */ - + /* Scheme system release version */ #ifndef RELEASE @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 44 +#define SUBVERSION 45 #endif #ifndef UCODE_TABLES_FILENAME diff --git a/v7/src/microcode/x11.h b/v7/src/microcode/x11.h index 565adbc7b..15805b125 100644 --- a/v7/src/microcode/x11.h +++ b/v7/src/microcode/x11.h @@ -1,6 +1,6 @@ /* -*-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 @@ -38,12 +38,20 @@ MIT in each case. */ #include #include "ansidecl.h" -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. */ @@ -61,32 +69,45 @@ struct drawing_attributes 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; +}; + 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; @@ -98,60 +119,19 @@ struct xwindow /* 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 }; - -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) @@ -172,61 +152,47 @@ extern int x_wait_for_event (); #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) + +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)); diff --git a/v7/src/microcode/x11base.c b/v7/src/microcode/x11base.c index 272316aff..56d2b41cc 100644 --- a/v7/src/microcode/x11base.c +++ b/v7/src/microcode/x11base.c @@ -1,6 +1,6 @@ /* -*-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 @@ -39,6 +39,17 @@ MIT in each case. */ #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) { @@ -57,222 +68,230 @@ DEFUN (x_realloc, (ptr, size), PTR ptr AND unsigned int size) return (result); } -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; - -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))); +} + 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; + +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); } - -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; + +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; -} - -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)); @@ -293,13 +312,11 @@ x_default_attributes (display, resource_name, attributes) (display, resource_name, "pointerColor", "Foreground", foreground_pixel)); } - return; } #define MAKE_GC(gc, fore, back) \ { \ XGCValues gcv; \ - \ (gcv . font) = fid; \ (gcv . foreground) = (fore); \ (gcv . background) = (back); \ @@ -311,34 +328,40 @@ x_default_attributes (display, resource_name, attributes) } 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; @@ -346,640 +369,546 @@ x_make_window (display, window, x_size, y_size, attributes, extra, deallocator, (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)))); -} -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)); } - -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); } - + 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); } + +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)))); } -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); -} - -#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); } } - + 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); +} + +/* 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; } -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.") + +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); } - - -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) + +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)))); } - + 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); } @@ -988,10 +917,8 @@ DEFINE_PRIMITIVE ("X-WINDOW-UNMAP", Prim_x_window_unmap, 1, 1, 0) { 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); } @@ -999,7 +926,7 @@ DEFINE_PRIMITIVE ("X-WINDOW-UNMAP", Prim_x_window_unmap, 1, 1, 0) 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); } @@ -1007,11 +934,11 @@ DEFINE_PRIMITIVE ("X-WINDOW-CLEAR", Prim_x_window_clear, 1, 1, 0) { 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); @@ -1019,321 +946,235 @@ DEFINE_PRIMITIVE ("X-WINDOW-CLEAR", Prim_x_window_clear, 1, 1, 0) 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); +} + 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))); } } - + 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); } - + 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); } - + 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); } - + 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); } - + 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); } - + 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); } diff --git a/v7/src/microcode/x11graph.c b/v7/src/microcode/x11graph.c index 84c973e35..2e4aade47 100644 --- a/v7/src/microcode/x11graph.c +++ b/v7/src/microcode/x11graph.c @@ -1,6 +1,6 @@ /* -*-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 @@ -37,10 +37,10 @@ MIT in each case. */ #include "scheme.h" #include "prims.h" #include "x11.h" - + #define RESOURCE_NAME "scheme-graphics" #define DEFAULT_GEOMETRY "512x384+0+0" - + struct gw_extra { float x_left; @@ -67,61 +67,77 @@ struct gw_extra #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)))); +} 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, @@ -135,21 +151,17 @@ set_clip_rectangle (xw, x_left, y_bottom, x_right, y_top) 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. */ @@ -160,150 +172,6 @@ reset_virtual_device_coordinates (xw) (((float) ((XW_Y_SIZE (xw)) - 1)) / ((XW_Y_BOTTOM (xw)) - (XW_Y_TOP (xw)))); reset_clip_rectangle (xw); - return; -} - -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(); } DEFINE_PRIMITIVE ("X-GRAPHICS-SET-VDC-EXTENT", Prim_x_graphics_set_vdc_extent, 5, 5, @@ -312,12 +180,11 @@ Set the virtual device coordinates to the given values.") { 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; @@ -329,26 +196,22 @@ Set the virtual device coordinates to the given values.") 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); } @@ -356,31 +219,59 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-CLIP-RECTANGLE", Prim_x_graphics_set_clip_rect "(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); } 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); @@ -389,21 +280,20 @@ wm_set_size_hint (xw, flags, x, y) (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))); \ \ } DEFINE_PRIMITIVE ("X-GRAPHICS-OPEN-WINDOW", Prim_x_graphics_open_window, 3, 3, @@ -412,99 +302,71 @@ Open a window on DISPLAY using GEOMETRY.\n\ 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)); + } } DEFINE_PRIMITIVE ("X-GRAPHICS-DRAW-LINE", Prim_x_graphics_draw_line, 5, 5, @@ -514,10 +376,10 @@ Subsequently move the graphics cursor to the end coordinates.") { 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)), @@ -536,11 +398,12 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-MOVE-CURSOR", Prim_x_graphics_move_cursor, 3, 3, "(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); } @@ -551,10 +414,10 @@ Subsequently move the graphics cursor to those coordinates.") { 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)), @@ -576,8 +439,8 @@ Subsequently move the graphics cursor to those coordinates.") { 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)), @@ -594,8 +457,8 @@ Draw characters in the current font at the given coordinates.") { 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)), @@ -613,9 +476,9 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FUNCTION", Prim_x_graphics_set_function, 2, 2, { 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); } @@ -626,9 +489,9 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-FILL-STYLE", Prim_x_graphics_set_fill_style, 2 { 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); } @@ -639,9 +502,9 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-LINE-STYLE", Prim_x_graphics_set_line_style, 2 { 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 @@ -654,11 +517,11 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0) { 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 @@ -667,10 +530,3 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0) } 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); -} diff --git a/v7/src/microcode/x11term.c b/v7/src/microcode/x11term.c index 91c60ea52..7a4fc9aa2 100644 --- a/v7/src/microcode/x11term.c +++ b/v7/src/microcode/x11term.c @@ -1,6 +1,6 @@ /* -*-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 @@ -37,11 +37,65 @@ MIT in each case. */ #include "scheme.h" #include "prims.h" #include "x11.h" -#include "x11term.h" + +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 +#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)), \ @@ -52,76 +106,64 @@ MIT in each case. */ 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; + } } 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); @@ -131,205 +173,333 @@ xterm_wm_set_size_hint (xw, flags, x, y) (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++); + } } 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; -} - -#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)); +} + +#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)); + } +} + +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; + } +} + +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)); + } } 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) @@ -338,7 +508,7 @@ 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 @@ -349,526 +519,382 @@ DEFINE_PRIMITIVE ("XTERM-SET-SIZE", Prim_xterm_set_size, 3, 3, 0) 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)))); -} - 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); } - + 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); } - + 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); } +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); } - -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); } - -#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); } -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); +} + +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); } diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index 42164b73c..48f44f7d1 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-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 @@ -33,7 +33,7 @@ promotional, or sales literature without prior written consent from MIT in each case. */ /* This file contains version information for the microcode. */ - + /* Scheme system release version */ #ifndef RELEASE @@ -46,7 +46,7 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 44 +#define SUBVERSION 45 #endif #ifndef UCODE_TABLES_FILENAME -- 2.25.1